Új hozzászólás Aktív témák

• #43121 Delila_1 veterán zsolti_20 #43114

  Új Válasz 2020-02-23 17:48:15 #43121

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  Delila_1

  veterán

  válasz zsolti_20 #43114 üzenetére

  Az AA oszlopba sorold fel a fájlneveket, kiterjesztéssel.

  A makró sorra megnyitja a fájlokat. Első esetben a B oszlopba írja be a képleteket, amik az első fájlból keresik ki az értékeket.
  Ahhoz, hogy a következő fájlnál ne írja ezeket felül, a másodikban való kereséshez a képletek a C oszlopba kerülnek, és így tovább. Nézd meg a Case utasításoknál, hogy mi változik.
  Az első sorában az oszlop helye (B: B), a másodikban a félkövér, aláhúzott karakterrel írt érték.
  "=IFERROR(VLOOKUP(RC[-1],[" & FN & "]Munka1!C1: C2,2,0),"""")"
  A Case 5-től majd beírod a többit.

  Sub Kigyujtes()
Dim WsGy As Worksheet, WsInnen As Worksheet, usorGy As Long, szamlalo As Integer
Dim FN As String, sor As Long, usorFajlnev As Long, utvonal As String

utvonal = "F:\Főmappa\Almappa\" 'ide jön a saját útvonalad, a végén \ legyen
Set WsGy = ActiveWorkbook.Sheets(1)
usorGy = WsGy.Range("A" & Rows.Count).End(xlUp).Row
usorFajlnev = WsGy.Range("AA" & Rows.Count).End(xlUp).Row
szamlalo = 1

For sor = 1 To usorFajlnev
FN = Cells(sor, "AA") 'itt vannak a fájlnevek kiterjesztéssel
Workbooks.Open utvonal & FN
szamlalo = szamlalo + 1
Set WsInnen = ActiveWorkbook.Sheets(1)
Select Case szamlalo
Case 2
WsGy.Range("B1:B" & usorGy).FormulaR1C1 = _
"=IFERROR(VLOOKUP(RC[-1],[" & FN & "]Munka1!C1:C2,2,0),"""")"
Case 3
WsGy.Range("C1:C" & usorGy).FormulaR1C1 = _
"=IFERROR(VLOOKUP(RC[-2],[" & FN & "]Munka1!C1:C2,2,0),"""")"
Case 4
WsGy.Range("D1:D" & usorGy).FormulaR1C1 = _
"=IFERROR(VLOOKUP(RC[-3],[" & FN & "]Munka1!C1:C2,2,0),"""")"
Case 5
Case 6
Case 7
Case 8
Case 9
Case 10
Case 11
End Select

ActiveWorkbook.Close False

'ha a képletek helyett fix értékeket szeretnél, a lenti két sort aktiváld
' Range("B:K").Copy
' Range("B1").PasteSpecial xlPasteValues
Next
End Sub

Új hozzászólás Aktív témák