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

• prodrakan csendes tag

  #2918

  #2911 Delila_1

  2017-10-10 21:54:25

  Új Válasz

  Ú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

  

  prodrakan

  csendes tag

  #2911 Delila_1

  #2911 Delila_1

  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ő.

  Elkezdtem tesztelgetni élesbe már az én Exceljeimmel.
  Az egyik Excel-el jól működik azaz az Excel1 és Excel2-őt sikerült összhangba hozni,de nálam másképp van nyilván elnevezve,de valami baja van a harmadik Excel-el azaz legyen Excel3-al.
  Valamiért ezzel a sorral van baja:
  TalalSor = WF.Match(Cells(sor, "A"), WB3.Sheets("Planner").Columns(1), 0)

  Üdv,
  Laci

• prodrakan csendes tag

  #2916

  #2915 Delila_1

  2017-10-10 13:43:38

  Új Válasz

  Ú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

  

  prodrakan

  csendes tag

  #2915 Delila_1

  #2915 Delila_1

  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

  Ez is úgy nézz ki,hogy szuper lett!!!

  Majd még tesztelgetem de remélem élesbe is menni fog.
  Ha esetleg éles helyzetbe felmerül valami akkor írhatok?

  Köszönöm a sok segítséget!
  Üdv,
  Laci

• prodrakan csendes tag

  #2914

  #2913 Delila_1

  2017-10-10 12:53:36

  Új Válasz

  Ú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

  

  prodrakan

  csendes tag

  #2913 Delila_1

  #2913 Delila_1

  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.

  Na most úgy néz ki,hogy tök szuper lett!!!!

  Extraként olyat meg lehet neki adni,hogy melyik héttel kezdje az ellenőrzést?
  Tehát minden maradna,ahogy most van csak felugrana egy ablak,ahol megkérdezné melyik héttel kezdjek.
  Az Excel1-ben a "B"-oszlopban 1-52.-ig lennének számok és azt szeretném,ha feljönne egy kérdés ahol lenyíló füllel kiválasztható lenne tól-ig meddig futtasa végig az ellenőrzést majd a felugrott ablakon belül egy INDÍT gomb megnyomásával a makró végigfutna.

  Ha ez nem fér bele az sem gond,mert már így is tök szuper,de akkor lenne igazán tökéletes.

• prodrakan csendes tag

  #2912

  #2911 Delila_1

  2017-10-10 09:26:41

  Új Válasz

  Ú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

  

  prodrakan

  csendes tag

  #2911 Delila_1

  #2911 Delila_1

  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ő.

  [kép]

  Szia!

  Csatoltam egy képet amin bejelöltem hol van a gond.
  Amúgy a pirossal jelölt szakaszokon kívül bárhonnan kitörlök azt tök jól betölti!
  ,kivétel ha a piros kereten belül bármelyik cellából hiányzik adat a G;J;K valamelyikéből.

  Kipróbáltam a munkahelyi és az otthoni gépen is,ugyanaz a hiba.

• prodrakan csendes tag

  #2910

  #2909 Delila_1

  2017-10-09 15:04:23

  Új Válasz

  Ú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

  

  prodrakan

  csendes tag

  #2909 Delila_1

  #2909 Delila_1

  Feltettem az újabb verzió-t.

  Na tesztelgettem és alapvetően tök szuper viszont a befagyás ennél is megvan.
  Azt vettem észre,hogy ha az utolsó vagy utolsó előtti sorból kitörlök és elindítom a makrót akkor lefagy az egész Excel.
  Tehát,ha az Excel1 "G" & "J" & "K" oszlopok bármelyikéből kitörlöm az utolsó vagy utolsó előtti sort akkor lefagy.
  A fentieken kívül ugyanez a helyzet az Excel1 15.-ik sorától felfele vagyis,ha a "G" & "J" & "K" oszlopok 13. vagy 14.-sorból hiányzik adat akkor szintén lefagy.
  Az összes többi területen nem produkálja a hibát max.,ha a Excel1 "G" & "J" & "K" oszlopok teljes tartalmát kitörlöm.

• prodrakan csendes tag

  #2908

  #2907 Delila_1

  2017-10-09 09:38:35

  Új Válasz

  Ú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

  

  prodrakan

  csendes tag

  #2907 Delila_1

  #2907 Delila_1

  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

  Köszönöm!

  Annyi hibát észleltem amúgy,hogyha az Excel1 "G" oszlopába a "Zöldség" megnevezésen kívül mindent kitörlök akkor valamiért nem csinálja meg és befagy.

  A többi oszlopba is ezen az elven kell dolgoznia a makrónak.
  AZ "A"-oszlop a fő szempont a többinél is annyi a változás,hogy az Excel1-ben ugyan ezt a feltételt futtassa le csak több oszlopot kell figyelnie azaz:
  Az Excel1-ben van "A" & "G" & "J" & "K" oszlopok
  Az Excel2-ben van "A" & "I" & "J" oszlopok
  És van egy Excel3 amiben van "A" & "I" oszlopok

  Az Excel1 "A" & "G" oszlopokat összefésüli az Excel2 "A" & "I" oszlopokkal "Ez amit már megoldottál!"
  Amit még kéne hogy:
  Az Excel1 "A" & "J" oszlopokat fésülje össze az Excel2 "A" & "J" oszlopokkal "Az elmélet ugyan az mint az előzőnél"
  Továbbá van egy Excel3!
  Amit itt kéne figyelnie :
  Az Excel1 "A" & "K" oszlopait kéne összefésülnie az Excel3 "A" & "I" oszlopaival "Az elmélet ugyan az mint az előzőnél"

  Ami jó lenne,ha nem kéne megnyitni kézzel mind a három Excel táblázatot vagyis az Excel1 táblázatba levő makró futtatásakor azaz a futtatás idejére nyissa meg magától az Excel2 & Excel3 táblázatokat majd zárja is be őket.Az esetleg az mennyire számítana,hogy a makró indításakor megnyitná az Excel2 és lefuttatná az ellenőrzést és bezárná majd megnyitná az Excel3-at és lefuttatná itt is az ellenőrzést majd bezárná vagyis lehetőleg ne egyszerre legyen nyitva 3-darab Excel mert az lehet lassítaná.

  Előre is köszönöm!

• prodrakan csendes tag

  #2906

  #2905 Delila_1

  2017-10-08 19:32:50

  Új Válasz

  Ú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

  

  prodrakan

  csendes tag

  #2905 Delila_1

  #2905 Delila_1

  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é.

  Na ez egész jónak tűnik!
  Jó lenne,ha a másik Excel nem kéne külön megnyitnom,hanem a makró automatikusan a futtatás idejére megnyitná majd bezárná.
  A másik kérdésem az lenne,hogy ugyanebbe a makróba macerás lenne belerakni plusz egy oszlop figyelést vagy inkább arra külön még egyszer ugyanezt csak átírom az "I" oszlop figyelést másra?
  Msbox ablak felugorhatna arra az időre amíg ez lefut mondjuk egy olyan kiírással,hogy "Dolgozom" vagy "Adatokat gyűjtök"?

  Kíváncsi leszek,hogy több ezer sornál hogy fog lefutni,de remélem gyors lesz.

  Köszönöm az eddigit is!
  Üdv,
  Laci

• prodrakan csendes tag

  #2904

  #2903 Delila_1

  2017-10-08 17:26:11

  Új Válasz

  Ú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

  

  prodrakan

  csendes tag

  #2903 Delila_1

  #2903 Delila_1

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

  Excel1 A4=adat és G4=adat akkor ugrik a következő sorba és ott
  A5=adat és G5=semmi akkor keresse az
  Excel2-ben az Excel1 A5-öt méghozzá Excel2 A1:A50000-ig és ha mondjuk megtalálja az
  Excel2 A3500-ban akkor az Excel2 I3500-cellában található adatott másolja át a
  Excel1 G5-be de,ha nem talál semmit akkor folytassa az
  Excel1 A6=adat és G6=adat akkor
  Excel1 A7=semmi akkor itt vége a futtatásnak

  Az Excel1 és Excel2 csak a könnyebb magyarázat miatt van.
  Remélem,így jobban értelmezhető.

• prodrakan csendes tag

  #2902

  #2901 Delila_1

  2017-10-08 14:40:55

  Új Válasz

  Ú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

  

  prodrakan

  csendes tag

  #2901 Delila_1

  #2901 Delila_1

  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.

  [kép]
  
  Szia!

  Köszönöm a segítséget,de szerintem nem jól írtam le valamit mert ez így nem az amit szerettem volna.
  Csatoltam egy képet.
  Van egy "Excel1" ami tartalmaz A-oszlopot és egy G-oszlopot és az A-oszlop adatát kell ellenőriznie egy másik "Excel2" A-oszlopába és ha megtalálta akkor a vele egy vonalba az I-oszlopba található adatot másolja át az "Excel1" A és G oszlop metszéspontjába.
  A függvényt csak addig futtassa,amíg az Excel1 A-oszlopába van adat.

• prodrakan csendes tag

  #2900 2017-10-08 09:14:16

  Új Válasz

  Ú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

  

  prodrakan

  csendes tag

  Sziasztok!

  Kellene egy kis segítség Excel makróban
  Nagyon kezdő szinten vagyok
  Van egy kész működő függvényem,amivel jelenleg használom a táblázatomat,de jobban szeretném ezt makróval futtatni,mivel jelenleg minden egyes megnyitáskor a legelejétől lefuttatja pedig nekem csak az első üres sortól kellene.
  A függvényem az alábbi:
  =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$4:$I$5000;HOL.VAN(A4;'\\Hubudr99102dat\mf\MF3\FEMSZERK_TERMELES\Fémszerkezet\2015.08.01_Komponens_és_szekrény_gyártás\Tervező\2017\[Tervező_2017.xlsm]Planner'!$A$4:$A$5000;0))

  A fenti függvénybe egy hiba van,hogy ha nincs adat a cellában akkor "01.00" ír a cellába,pedig akkor jobb lenne,ha üresbe hagyná.
  Azt szeretném,ha megkeresné az első olyan cellát a 'K'-oszlopba,ami üres és ugyan abba a sorba az 'A'-oszlopba is van adat és innentől futtatná le a függvényemet.

  Segítségeteket előre is köszönöm!

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