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

• #2919 Delila_1 veterán prodrakan #2918

  Új Válasz 2017-10-11 06:55:58 #2919

  Ú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 prodrakan #2918 üzenetére

  A harmadik fájl Planner lapján nem az A oszlopban vannak azok az adatok, mint a másik kettőben.

• #2917 Delila_1 veterán prodrakan #2916

  Új Válasz 2017-10-10 14:11:49 #2917

  Ú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 prodrakan #2916 üzenetére

  Persze. Privátban megadom a címem.

• #2915 Delila_1 veterán prodrakan #2914

  Új Válasz 2017-10-10 13:10:28 #2915

  Ú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 prodrakan #2914 üzenetére

  A makrót írd át.

  Sub Parosit()
Dim usor As Long, sor As Long, utvonal As String
Dim WB1 As Workbook, WB2 As Workbook, WB3 As Workbook
Dim WF As WorksheetFunction, TalalSor As Long
Dim kezd As Long, vegez As Long


Set WB1 = Workbooks("Excel1.xlsm")
Set WF = Application.WorksheetFunction
utvonal = "F:\Eadat\Excel fórumok\PH\"

kezd = Application.InputBox("Add meg a kezdő hét sorszámát", "Kezdő hét", , , , , , 1)
vegez = Application.InputBox("Add meg a záró hét sorszámát", "Záró hét", , , , , , 1)

kezd = WF.Match(kezd, Columns(2), 0)
vegez = WF.Match(vegez, Columns(2), 1)

Application.StatusBar = "Nyugi, dolgozom"
Application.ScreenUpdating = False

usor = WB1.Sheets("Munka1").Range("A" & Rows.Count).End(xlUp).Row

'Excel2-ből I oszlop az Excel1 G-be
Workbooks.Open Filename:=utvonal & "Excel2.xlsx"
Set WB2 = Workbooks("Excel2.xlsx")
WB1.Activate

For sor = kezd To vegez
If Cells(sor, "G") = "" And Cells(sor, "A") <> "" Then
TalalSor = WF.Match(Cells(sor, "A"), WB2.Sheets("Munka1").Columns(1), 0)
Cells(sor, "G") = WB2.Sheets("Munka1").Cells(TalalSor, "I")
End If

If Cells(sor, "J") = "" And Cells(sor, "A") <> "" Then
TalalSor = WF.Match(Cells(sor, "A"), WB2.Sheets("Munka1").Columns(1), 0)
Cells(sor, "J") = WB2.Sheets("Munka1").Cells(TalalSor, "J")
End If
Next
WB2.Close False

'Excel3-ból I oszlop az Excel1 K-ba
Workbooks.Open Filename:=utvonal & "Excel3.xlsx"
Set WB3 = Workbooks("Excel3.xlsx")
WB1.Activate

For sor = kezd To vegez
If Cells(sor, "K") = "" And Cells(sor, "A") <> "" Then
TalalSor = WF.Match(Cells(sor, "A"), WB3.Sheets("Munka1").Columns(1), 0)
Cells(sor, "K") = WB3.Sheets("Munka1").Cells(TalalSor, "I")
End If
Next
WB3.Close False

Application.StatusBar = False
Application.ScreenUpdating = True
End Sub

• #2913 Delila_1 veterán prodrakan #2912

  Új Válasz 2017-10-10 11:53:40 #2913

  Ú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 prodrakan #2912 üzenetére

  Annál a módszernél, amit írtál (első üres sortól kezdje bemásolni a másik 2 fájlból az adatokat), túl sok a hibalehetőség. Most megírtam úgy, hogy az első adattól, a 4. sortól fusson végig egy For-Next ciklussal addig a sorig, ahol az A oszlopban megtalálja az utolsó adatot.

  Csatolás

  Az útvonal értékét a makró 10. sorában kell átírni, és esetlegesen új értéket adni neki a 36. sor előtt.

• #2911 Delila_1 veterán prodrakan #2910

  Új Válasz 2017-10-09 16:44:14 #2911

  Ú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 prodrakan #2910 üzenetére

  Feltöltöttem az Excel1-et. Mindhárom oszlopban töröltem az utolsó sorokat, azokat is kitölti a makró.

  A lefagyásnak valami helyi oka lehet, nálam nem fordul elő.

• #2909 Delila_1 veterán prodrakan #2908

  Új Válasz 2017-10-09 13:35:57 #2909

  Ú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 prodrakan #2908 üzenetére

  Feltettem az újabb verzió-t.

• #2907 Delila_1 veterán prodrakan #2906

  Új Válasz 2017-10-09 08:38:00 #2907

  Ú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 prodrakan #2906 üzenetére

  Beírtam a makróba, hogy amíg dolgozik, a státuszsorban megjelenik a "Nyugi, dolgozom" szöveg. Kevés adatnál nem látszik, olyan gyorsan eltűnik.

  Pontosítanod kellene, melyik oszlopot akarod még figyeltetni, mit figyeljen a makró, és mit tegyen.

  Sub Kikeres()
Dim UresSor As Long, WSInnen As Worksheet, WSIde As Worksheet
Dim TalalSor, usor As Long, WF As WorksheetFunction

Set WSInnen = Workbooks("Excel2.xlsx").Sheets("Munka1")
Set WSIde = Workbooks("Excel1.xlsm").Sheets("Munka1")
Set WF = Application.WorksheetFunction

WSIde.Activate

Application.StatusBar = "Nyugi, dolgozom"
Application.ScreenUpdating = False

usor = Range("G" & Rows.Count).End(xlUp).Row
Do
UresSor = Range("G" & usor).End(xlUp).Row - 1
If UresSor < 3 Then
Application.StatusBar = False
Application.ScreenUpdating = True
Exit Sub
End If

If Cells(UresSor, "A") <> "" Then
On Error Resume Next
TalalSor = WF.Match(Cells(UresSor, "A"), WSInnen.Columns(1), 0)
Cells(UresSor, "G") = WSInnen.Cells(TalalSor, "I")
On Error GoTo 0
Else: usor = UresSor - 1
End If
Loop Until Cells(UresSor, "A") <> "" And Cells(UresSor, "G") = ""
End Sub

• #2905 Delila_1 veterán prodrakan #2904

  Új Válasz 2017-10-08 18:14:51 #2905

  Ú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 prodrakan #2904 üzenetére

  Feltettem a 2 fájlt.

  Mindkét füzet legyen nyitva, az Excel1.xlsm-be kitettem egy gombot a makró indításához.

  Érdemes az alsó sorból indulni, és addig keresni felfelé a G oszlopban az üres cellákat, míg fel nem jutunk a 3-as sorban lévő címsor fölé.

• #2903 Delila_1 veterán prodrakan #2902

  Új Válasz 2017-10-08 16:54:03 #2903

  Ú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 prodrakan #2902 üzenetére

  Fuss neki újra! Az A és G oszlopnak nincs metszéspontja.

• #2901 Delila_1 veterán prodrakan #2900

  Új Válasz 2017-10-08 14:07:23 #2901

  Ú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 prodrakan #2900 üzenetére

  Próbáld ezzel:

  Sub IndexFuggveny()
Dim UresSor As Long

UresSor = Range("K1").End(xlDown).Row + 1
Do
If Cells(UresSor, "A") = "" Then UresSor = UresSor + 1
Loop Until Cells(UresSor, "A") <> "" And Cells(UresSor, "K") = ""

Range("C" & UresSor & ":C5000") = "=INDEX('\\Hubudr99102dat\mf\MF3\" _
& "FEMSZERK_TERMELES\Fémszerkezet\2015.08.01_Komponens_és_szekrény_gyártás\" _
& "Tervező\2017\[Tervező_2017.xlsm]Planner'!$I$" & UresSor & ":$I$5000;HOL.VAN(A" & UresSor & "," _
& "'\\Hubudr99102dat\mf\MF3\FEMSZERK_TERMELES\Fémszerkezet\2015.08.01_Komponens_és_szekrény_gyártás\" _
& "Tervező\2017\[Tervező_2017.xlsm]Planner'!$A$" & UresSor & ":$A$5000,0))"
End Sub

  A Range("K1").End(xlDown).Row a K1 cellán nyomott Ctrl+le művelet VBA-s megfelelője. Ez az első, üres cella fölötti sor értékét adja meg. 1-et hozzáadva megkapjuk az első üres cella sorát a K oszlopban.
  Ha ez a sor az A oszlopban üres, addig növeljük a sorszámot, míg igaz nem lesz, hogy a K üres, az A nem.
  Ide, ill. innen az ötezredik sorba írjuk be (nálam a C oszlopba, te majd átírod) a hosszú képletedet, egy lépésben.

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