Az „Excel” fórum célja, hogy keretet adjon az Excel felhasználók széles táborának tapasztalataik megosztására, és lehetőséget a segítséget kérőknek. Az alábbi összefoglaló azért készült, hogy segítse a helyes kérdésfeltevést.
– Írd le szabatosan a problémát. Úgy fogalmazz, hogy ne csak te magad, de a szakértő is megértse, mire szeretnél választ kapni.
– Írd le, hogy milyen verziójú Excellel dolgozol. (Vagy ha nem – ill. nem csak – Excel, akkor micsoda?)
– Írd le, hogy milyen úton indultál el, és hol akadtál el rajta.
– A kérdés megértése szempontjából sokat segíthet, ha feltölteszt egy képet, amin látszik, hogy mit szeretnél, vagy illusztrálja azt.
– Még jobb, ha feltöltesz egy minta munkafüzetet valahová (pl. data.hu). Feltöltés előtt távolítsd el belőle a nem publikus adatokat.
– Ha a feladat jellege olyan, célszerű az "előtte" és "utána" állapotokat bemutatni. (Miből kellene csinálni mit?)
– Ha VBA kódon kell javítani, másold be a releváns kódrészt. Rövid kód mehet hozzászólásba, hosszú kód inkább ide: http://pastebin.com/
– Ha valami nem úgy működik, ahogy kellene, add meg a rendellenes viselkedés jellemzőit, a hibaüzenetet, és a hibát okozó programsort.
Köszönöm az ötletet, de közben rájöttem, hogy azért nem tudta az Excel hova másoljon, mert cellákat töröltem és nem sorokat.
/Persze nem értem miért volt ez baj neki, de mindegy/
Az őrület környékez. Kikészülök ettől a #&@&# makrótól. Főleh, hogy szerintem olyan közel vagyok amegoldához és mégis távolt :-D.
Minden ami zöld a csodásan működik, mert kipróbáltam.
Ami problémás az a maradék...
DE MIÉRT??????????????????????????????
Megőrülök!!!!!!!!
Sub megnyitás() respond = MsgBox("Do you have other excel file open?", vbYesNo, "Question:") On Error GoTo Errorcatch If respond = vbYes Then MsgBox "Please close all excel files except the template!" Exit Sub Else
With Application.FileSearch .LookIn = útvonal .FileType = msoFileTypeExcelWorkbooks .Execute For i = 1 To .FoundFiles.Count Workbooks.Open .FoundFiles(i) Next
A temlétből törlöm a bemásolt sorokat, mentem és becsukok mindent.
Újra nyitom a templétet, az excel mintha emlékzne, hogy ott volt korábban pár sor, amit töröltem és folytattja a "kitörölt", tehát fizikailag már nem ott lévő sorok alatt.
Immediat ablakban csináltam, úgy hogy részenként tesztelem...
Leegyszerűsítettem és kinyitottam a temlétet meg a Book2 fájlt, hogy megnézzem a copy működik-e.
Vicces mert úgy tűnik hiányzott egy cell select parancs és most már kopizza, viszont egy dolgot baromira nem értek...
Ahányszor futtatom a makrót mindig lejjebb és lejjebb másol, amit totál nem értek...hiszem ha én kitörlöm az előző bemásolt sorokat, akkor a használt sorok száma marad 1...
Nem tudom értitek-e...
A lenti részt teszteltem. És működik is. Elvileg hurrá. Viszont, ha újra próbálkozom ennek a kódnak a futtatásával, úgy hogy amit korábban bemásolt 2 sor törlöm, akkor ő mintha úgy látná, hogy ott továbbra is van valami...és a már kitörölt sorok alá másolja be az újat?
Excel-ben adott egy sorban néhány cella, melynek tartalam "P". Azt kellene leellenőrizni, hogy "P" és "P"-t tartalamzó cellák közti cellák száma nem több 6-nál. Amennyiben több jelölje ki a két "P" közti cellákat pirosal.
Én arra gyanakszom, hogy vagy a workbook-kal vagy a worksheet(1)-el van valami gond.
Még egy elméleti hibalehetőség (nem gondolom, h ez a gond, de jobb helyretenni) az hogy wawabagus kódjában Sheets(1) szerepel, nem pedig Worksheets(1). Elméletben ez okozhat olyan hibát, hogy ha az első sheet pld egy Chart akkor azt próbálja kijelölni és kopizni. Én nem szeretek Sheet-re hivatkozni, mert sose tudja az ember, hogy olyan sheet-e, mint amivel igazán dolgozni szeretne...
Kicsit mellékszál:
A sok xldown és xltoright helyett lehetne használni a következő technikát is:
Dim SourceWS As Worksheet
Set ws = Workbooks("book1").Worksheets(1)
SourceWS.Range("A1").CurrentRegion.Copy
Merthogy a CurrentRegion object direkt erre van (excel felületen a Ctrl+*)
Sub megnyitás() Dim respond As Long, útvonal As String Dim wbSource As Workbook, rngTarget As Worksheet
respond = MsgBox("Do you have other excel file open?", vbYesNo, "Question:") If respond = vbYes Then MsgBox "Please close all excel files except the temple!" Exit Sub Else útvonal = "S:AdHoc AnalysisMACROKrisztateszt" With Application.FileSearch .LookIn = útvonal .FileType = msoFileTypeExcelWorkbooks .Execute For i = 1 To .FoundFiles.Count Set wbSource = Workbooks.Open(.FoundFiles(i)) Set rngTarget = Workbooks("Trackcode merge template.xls").Sheets("Combine").Range("A" & Rows.Count).End(xlUp).Offset(1) wbSource.Sheets(1).UsedRange.Offset(1).Copy rngTarget.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, SkipBlanks:=False, Transpose:=False wbSource.Close SaveChanges:=False Next End With End If End Sub
Sőt, szerintem ebből a "respond" begyűjtése és kiértékelése is kihagyható.
Sub megnyitás() Dim respond As Long, útvonal As String Dim wbSource As Workbook, rngTarget As Worksheet
respond = MsgBox("Do you have other excel file open?", vbYesNo, "Question:") If respond = vbYes Then MsgBox "Please close all excel files except the temple!" Exit Sub Else
útvonal = "S:AdHoc AnalysisMACROKrisztateszt"
With Application.FileSearch .LookIn = útvonal .FileType = msoFileTypeExcelWorkbooks .Execute For i = 1 To .FoundFiles.Count Set wbSource = Workbooks.Open(.FoundFiles(i)) Set rngTarget = Workbooks("Trackcode merge template.xls").Sheets("Combine").Range("A" & Rows.Count).End(xlUp).Offset(1) wbSource.Sheets(1).UsedRange.Offset(1).Copy rngTarget.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, SkipBlanks:=False, Transpose:=False wbSource.Close SaveChanges:=False Next End With End If
