-
IT café
A Microsoft Excel topic célja segítséget kérni és nyújtani Excellel kapcsolatos problémákra.
Kérdés felvetése előtt olvasd el, ha még nem tetted.
Új hozzászólás Aktív témák
-
Delila_1
Topikgazda
válasz mr.nagy #3931 üzenetére
Van itt két makró, sajnos nem én írtam őket. Az első jó a feladatodra.
Function CountColor(Mintacella As Range, Tartomany As Range)
'Összeszámolja, hogy a mintaként jelölt háttérszínű cellából hány darab
'van a kijelölt tartományban.
Dim rngCell As Range
nColor = Mintacella.Interior.Color
nResult = 0
For Each rngCell In Tartomany
If rngCell.Interior.Color = nColor Then
nResult = nResult + 1
End If
Next rngCell
CountColor = nResult
End Function
Function SumColor(Mintacella As Range, Tartomany As Range)
'A mintaként bejelölt hátterű cellákban szereplő számokat összegzi
Dim rngCell As Range
nColor = Mintacella.Interior.Color
nResult = 0
For Each rngCell In Tartomany
If rngCell.Interior.Color = nColor Then
nResult = nResult + WorksheetFunction.Sum(rngCell)
End If
Next rngCell
SumColor = nResult
End FunctionMásold be a makrókat egy üres füzet makró szerkesztőjébe, majd mentsd el SzinesCella.xla (Microsoft Excel bővítmény) formában. Jelöld be az Eszközök/Bővítmények között megjelenő SzinesCella nevűt, ezután alkalmazhatod függvényként. A függvények között a Felhasználói kategóriában, és persze a Mind-ben találod meg a CountColor és a SumColor nevezetűt. A makrókba beírtam, melyik mit csinál (és a nevük is utal rá).
Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
Cuci3
tag
válasz mr.nagy #5433 üzenetére
Elkezdtem ezen gondolkodni. Direkten nincs ilyen lehetőség, indirekten pedig makróval lehet valamit megoldani. De tuti belassítaná a munkafüzetet.
Autofilter makró lehetőségeinek elolvasása után én így látom a probléma megoldását:
1. Betöltéskor a B oszlop autószűrő kritéiumát el kellene tárolni.
2. Ha változik valami a munkafüzetben, akkor megnézni, hogy változott-e a kritérium
3. Ha változott a kritérium, akkor a kritériumnak megfelelő elemeket kiíratni valahova. A kiírásra egyelőre nem találtam tuti megoldást, úgy tűnik az A oszlop összes használt során végig kell lépkedni, és megnézni, hogy egyezik-e a kritériummal.Valakinek valami jobb ötlete?
-
Cuci3
tag
válasz mr.nagy #5745 üzenetére
A kérdés tök jó, de még sose jöttem rá, hogy pontosan hogyan kellene.
Amit ismerek 2003-ban: megvan a pivot, ráállsz valamelyik részére Formázás / Automatikus formázás. Onnan kiválasztasz egyet, de ne az utolsó kettőt. Megjelenik szép színesbe a kimutatás, de az adatok már oszlopba bontva. Aztán újra Automatikus formázás, majd a bal alsó kinézet választása (ez a normális kinézetet hozza vissza).Tuti valahol valami opció, de sose jöttem rá, hogy merre kellen keresni.
-
Delila_1
Topikgazda
válasz mr.nagy #6234 üzenetére
A kimutatásról készíts egy másolatot úgy, hogy másolod, és egy másik helyre irányítottan beilleszted az értékét. Ezen a táblázaton már bármilyen változtatást elkövethetsz.
Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
ulrik19
tag
válasz mr.nagy #6234 üzenetére
Szia, ha nem változik a kimutatástábla szerkezete (sorok és oszlopok száma), akkor simán tudsz az adott cellára hivatkozni máshol (pl. =F8)
Persze akkor is tudsz hivatkozni bármelyik adatra ilyen formában, ha változik a tábla szerkezete, de akkor nyomok kell követni a változást.
Egyébként van olyan fajta linkelési (adatkinyerési) mód, amikor nem a konkrét cellára hivatkozol, hanem magára az adatra (melyik adatsor, vagyis hónap, melyik oszlopadata), ezáltal ha változik a megjelenítési helye, akkor is tudja kezelni.
De először tudni kell, hogy mennyire változó a tábla.
...az élet igazságos, mert pl. akinek rövidebb az egyik lába, annak hosszabb a másik...
-
ulrik19
tag
válasz mr.nagy #6238 üzenetére
Csinálsz egy "végeredmény" táblát, amiben benne vannak a plusz oszlopok is (gondolom megbújik benne szinte valamennyi oszlop a kimutatásból)
A sorok száma ezek szerint változó, de nem is lényeges.
Az átszívandó oszlopokra tudsz hivatkozni: pl. =adattabla!A5 (ha a kimutatás az adattabla nevű sheeten van, és az A oszlop adata kell, ami az 5-ös sortól indul)
Amikor a képletet lefelé másolod, a következő adatsort veszi a kimutatásból.
Minden egyes oszlopnál ezt beállítod, köztük simán lehet olyan oszlop, amit Te töltögetsz.
...az élet igazságos, mert pl. akinek rövidebb az egyik lába, annak hosszabb a másik...
-
Delila_1
Topikgazda
-
félisten
válasz mr.nagy #6297 üzenetére
Hali!
Pedig amit Delila_1 írt, az működik, itt egy kicsit "továbbfejlesztve": [link]
Valóban a Te "készülékedben" van a hiba...Fire.
[ Szerkesztve ]
Mindenki tudja, hogy bizonyos dolgokat nem lehet megvalósítani, mígnem jön valaki, aki erről nem tud, és megvalósítja. (Albert Einstein)
-
félisten
válasz mr.nagy #6411 üzenetére
Hali!
Elsőre azt mondanám, hogy túl hosszú a kód. Magyarul szét kell darabolnod a SUB-ban lévő kódot több szubrutin hívásra.
(A logikailag összetartozó kódsorokat rakd egy külön SUB-ba, amit az alap CommandButton1_Click()-ből hívsz meg.Fire.
Mindenki tudja, hogy bizonyos dolgokat nem lehet megvalósítani, mígnem jön valaki, aki erről nem tud, és megvalósítja. (Albert Einstein)
-
félisten
-
félisten
válasz mr.nagy #6418 üzenetére
Hali!
Tehát akkor összefoglalnám. Minden gépen ugyanolyan verziójú és szervízpakkal elátott XP fut, valamint ugyanolyan verziójú és szervízpakkal ellátott Office 2003, ennek ellenére az asztali gépeken működik a makród kifogástalanul, míg a noti(ko)n/laptop(oko)n nem?
Nincs esetleg Visual Basic telepítve külön? (vagy az asztalikra vagy a notikra)
Fire.
[ Szerkesztve ]
Mindenki tudja, hogy bizonyos dolgokat nem lehet megvalósítani, mígnem jön valaki, aki erről nem tud, és megvalósítja. (Albert Einstein)
-
ulrik19
tag
válasz mr.nagy #6411 üzenetére
egyelőre nem nézegettem meg jobban a kódod, de nem értem, hogy kerül a képbe a windows objektum. Ne keverd a workbooks-szal.
Persze azt nem tudom, hogy függ ez össze azzal, hogy egyik gépen megy, a másikon meg nem. (lehet, hogy valamelyik hiányolja a névnél a .xls kiterjesztést? esetleg túl hosszú a filenév, és valamiért dos-osként kezeli 8.3 módon?)
egyébként csatlakoznék a kód tömörítésére tett javaslathoz.
[ Szerkesztve ]
...az élet igazságos, mert pl. akinek rövidebb az egyik lába, annak hosszabb a másik...
-
Delila_1
Topikgazda
válasz mr.nagy #6453 üzenetére
Az "Előző akc. Időpont" címkét az oszlopcímkék közül át kell tenned a sorcímkékhez.
Ilyen sok adatnál talán érdemes lenne az áruházat a Jelentésszűrő mezőbe tenni, mert az összes áruház egyszerre történő megjelenítésével követhetetlen, túl sok az adat.
[ Szerkesztve ]
Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
ulrik19
tag
válasz mr.nagy #6453 üzenetére
szöveges mezővel (szerintem) nem fog működni.
ellenben ha dátumot teszel be (mondjuk mindig az akció kezdetét), akkor pl. minimum-ot hozzárendelve, ott lesz a keresett érték.de csinálhatod azt is, hogy külön-szeded a dátum1/dátum2 formátumot két oszlopra, mindkettő külön adatmező lesz (dátum formátumban), majd a pivotba is így teszed be őket egymás mellé (szintén minimum, vagy maximum függvényt illesztve rá)
...az élet igazságos, mert pl. akinek rövidebb az egyik lába, annak hosszabb a másik...
-
félisten
válasz mr.nagy #6756 üzenetére
Hali!
Ez az elv, ha egy adott cellában lévő linkre hivatkozol, akkor alakíts a makrón(nem nehéz). Ebben a példában azt tanulhatod meg, hogy hogy kell netről megnyitni egy (ebben az esetben) képet és azt hogy kell pozicionálni(itt A1 cellához van igazítva)
Private Sub CommandButton1_Click()
Dim myPic As Object
Set myPic = ActiveSheet.Pictures.Insert("http://www.prohardver.hu/dl/faces/c14.gif")
myPic.Left = ActiveSheet.Range("A1").Left
myPic.Top = ActiveSheet.Range("A1").Top
End SubFire.
Mindenki tudja, hogy bizonyos dolgokat nem lehet megvalósítani, mígnem jön valaki, aki erről nem tud, és megvalósítja. (Albert Einstein)
-
félisten
válasz mr.nagy #6760 üzenetére
Hali!
Private Sub CommandButton1_Click()
Dim myPic As Object
Set myPic = ActiveSheet.Pictures.Insert(Range("A1"))
myPic.Left = ActiveSheet.Range("B1").Left
myPic.Top = ActiveSheet.Range("B1").Top
End SubFire.
[ Szerkesztve ]
Mindenki tudja, hogy bizonyos dolgokat nem lehet megvalósítani, mígnem jön valaki, aki erről nem tud, és megvalósítja. (Albert Einstein)
-
félisten
válasz mr.nagy #6762 üzenetére
Hali!
Private Sub CommandButton1_Click()
Dim myPic As Object
Set myPic = ActiveSheet.Pictures.Insert(Range("A1"))
myPic.Left = ActiveSheet.Range("F1").Left + ((ActiveSheet.Range("F1").Width - myPic.Width) / 2)
myPic.Top = ActiveSheet.Range("F1").Top
MsgBox (ActiveSheet.Range("F1").Width)
End SubEbből adódóan házi feladat, hogy hogy lehet függőlegesen is középre igazítani. (A példa alapján nem jelenthet gondot)
Fire.
[ Szerkesztve ]
Mindenki tudja, hogy bizonyos dolgokat nem lehet megvalósítani, mígnem jön valaki, aki erről nem tud, és megvalósítja. (Albert Einstein)
-
félisten
válasz mr.nagy #6764 üzenetére
Hali!
Majdnem...
Függőleges igazításnál a cella ill. kép magasságával kell számolni, ami mindkét esetben a Height nem pedig a Width.Persze ha a kép szélessége és magassága azonos, akkor nem jön ki a hiba.
(meg akkor sem, ha a cella magassága(sormagasság) kisebb, mint a kép magassága)Fire.
[ Szerkesztve ]
Mindenki tudja, hogy bizonyos dolgokat nem lehet megvalósítani, mígnem jön valaki, aki erről nem tud, és megvalósítja. (Albert Einstein)
-
mr.nagy
tag
válasz mr.nagy #6851 üzenetére
Időközben magam is törtem a felyem és egy ilyen kódot csináltam:
Private Sub CommandButton1_Click()
Sheets("tábla").Activate
On Error Resume Next
ActiveSheet.Shapes("kép").Select
Selection.Delete
On Error GoTo 0
Dim myPic As Object
Set myPic = Sheets("tábla").Pictures.Insert(Sheets("adatok").Range("C1"))
myPic.Left = Sheets("tábla").Range("C5").Left + ((Sheets("tábla").Range("C5").Width - myPic.Width) / 2)
myPic.Top = Sheets("tábla").Range("C5").Top + ((Sheets("tábla").Range("C5").Height - myPic.Height) / 2)
myPic.Name = ("kép")
End SubEddig úgy tűnik, hogy működik, de ha van jobb özlet nyitott vagyok rá és megköszönöm!
HMNote10Pro
-
félisten
válasz mr.nagy #8056 üzenetére
Hali!
Ez a kód remek alapot kínál a megoldásra, hisz nem kell mást tenned, mint a SumColor függvényt meghívni párszor. Pl A1 : A100 ban vannak az adatok, a feltételes formázás 3 színnel dolgozik, akkor erre a három színre kifested a B1/B2/B3 cellákat, majd valamelyik cellába pl C1-be meg beírod ezt
=SumColor(B1;A1:A100)+SumColor(B2;A1:A100)+SumColor(B3;A1:A100)Fire.
UI: Nem próbáltam ki, de elméletben így működnie kell a dolognak.
Mindenki tudja, hogy bizonyos dolgokat nem lehet megvalósítani, mígnem jön valaki, aki erről nem tud, és megvalósítja. (Albert Einstein)
-
ulrik19
tag
válasz mr.nagy #8063 üzenetére
Az interior.colorindex a cella beállított háttérszínét tartalmazza, a feltételes formázás hatására létrejött színt nem. (tehát a cella alapbeállítása van itt)
Sajnos nem tudok olyan egyszerű megoldásról, amivel meg lehet kapni az aktuális színt (tehát nincs a celláknak ilyen tulajdonságuk), persze kerülő úton meg lehet oldani:
a) ha azonos a feltételes formázás minden cellában, akkor nem szín, hanem maga a feltétel alapján összegzed, számolod össze a cellákat, tehát a feltételt "bedrótozod" a makróba
b) általánosabb megoldás, ha visszafejted a feltétel formázás paramétereit a cella FormatConditions alapján, és összeveted a cella aktuális értékével. Itt ahány feltételt állítottál be, annyi dimenziós tömböt látsz (FormatConditions(i), vagy FormatConditions.Item(i), ahol az elemek számát a FormatConditions.Count-ból kapod meg). Ha valamelyik feltétel teljesül, a feltétel háttérszíne lesz a megjelenő szín, FormatConditions(1).Interior.Colorindex, ha egyik sem, akkor a cella alapbeállítása szerinti szín látszik.ez talán lehet kiinduló alap hozzá:
[link]...az élet igazságos, mert pl. akinek rövidebb az egyik lába, annak hosszabb a másik...
-
Delila_1
Topikgazda
válasz mr.nagy #8063 üzenetére
Fel akartam tölteni a módosított füzetet, de valahogy nem jött össze.
A képletek:
O9 =ÁTLAG(C9:M9)
Q9 =DARABTELI(C9:M9;">" & O9+2)
R9 =SZUMHA(C9:M9;">" & O9+2;C9:M9)
S9 =DARABTELI(C9:M9;"<" & O9-1)
T9 =SZUMHA(C9:M9;"<" & O9-1;C9:M9)
U9 =DARAB(C9:M9)-Q9-S9
V9 =SZUM(C9:M9)-R9-T9[ Szerkesztve ]
Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
félisten
válasz mr.nagy #8067 üzenetére
Hali!
Igen, a problémát az okozza, hogy a feltételes formázásnál, nem a hagyományos háttérszín módosítás megy végbe. Én egy teljesen más megközelítést használtam ebben a kódban, azaz én magam írom meg a feltételeket és színezem a cellákat a feltételnek megfelelően. Ez biztosan kifogástalanul működik.
A makróban 2 dolgot kell megadni(bele is írtam hogy hol), az egyik a tartomány, amiben a kód dolgozik, a másik az eredménytábla bal felső cellája(mert hogy eredménytáblát hoz létre, amit persze módosíthatsz az igényednek megfelelően)
Ahány feltétel, annyival kell módosítani illetve az eredménytábla kiírását bővíteni/csökkenteniPrivate Sub Worksheet_Change(ByVal Target As Range)
Dim My_Range As Range
'Itt megadod, hogy milyen tartományban dolgozzon a kód
Set My_Range = Range("C9:M9")
Dim My_Dest_Range As Range
'Itt megadod a kezdőcellát, ahova az eredménytábla kerül
Set My_Dest_Range = Range("C11")
If Not Intersect(My_Range, Range(Target.Address)) Is Nothing Then
Call My_Conditions(My_Range, My_Dest_Range)
End If
End SubEz pedig Module1-ba kerül
Sub My_Conditions(My_Range As Range, Dest_Range As Range)
Col1Index = 3
Col2Index = 4
Col3Index = 5
ColEmpty = xlNone
Col1Num = 0
Col1Sum = 0
Col2Num = 0
Col2Sum = 0
Col3Num = 0
Col3Sum = 0
ColEmptyNum = 0
ColEmptySum = 0
Application.ScreenUpdating = False
For Each CurrCell In My_Range
If CurrCell.Value >= 0 And CurrCell.Value <= 5 Then
CurrCell.Interior.ColorIndex = Col1Index
Col1Num = Col1Num + 1
Col1Sum = Col1Sum + CurrCell.Value
ElseIf CurrCell.Value > 5 And CurrCell.Value <= 7 Then
CurrCell.Interior.ColorIndex = Col2Index
Col2Num = Col2Num + 1
Col2Sum = Col2Sum + CurrCell.Value
ElseIf CurrCell.Value > 7 And CurrCell.Value <= 10 Then
CurrCell.Interior.ColorIndex = Col3Index
Col3Num = Col3Num + 1
Col3Sum = Col3Sum + CurrCell.Value
Else: CurrCell.Interior.ColorIndex = xlNone
ColEmptyNum = ColEmptyNum + 1
ColEmptySum = ColEmptySum + CurrCell.Value
End If
Next CurrCell
Dest_Range.Select
ActiveCell(1, 1) = "Piros cella darabszám"
ActiveCell(1, 2) = Col1Num
ActiveCell(2, 1) = "Piros cella összeg"
ActiveCell(2, 2) = Col1Sum
ActiveCell(3, 1) = "Zöld cella darabszám"
ActiveCell(3, 2) = Col2Num
ActiveCell(4, 1) = "Zöld cella összeg"
ActiveCell(4, 2) = Col2Sum
ActiveCell(5, 1) = "Kék cella darabszám"
ActiveCell(5, 2) = Col3Num
ActiveCell(6, 1) = "Kék cella összeg"
ActiveCell(6, 2) = Col3Sum
ActiveCell(7, 1) = "Színtelen cella darabszám"
ActiveCell(7, 2) = ColEmptyNum
ActiveCell(8, 1) = "Színtelen cella összeg"
ActiveCell(8, 2) = ColEmptySum
Application.ScreenUpdating = True
End SubFire.
[ Szerkesztve ]
Mindenki tudja, hogy bizonyos dolgokat nem lehet megvalósítani, mígnem jön valaki, aki erről nem tud, és megvalósítja. (Albert Einstein)
-
Delila_1
Topikgazda
válasz mr.nagy #8219 üzenetére
Miért nem jó a körlevél? Ahhoz is tudsz Excel adatokat csatolni.
Az Excelben egyszerre csak 1 űrlapot tudsz kinyomtatni, azt, amelyiknek az adatai éppen szerepelnek az adatlapon.Az elkészített sablonba így tudod bekérni az adatokat (pl.):
=AdatokatTartalmazóLap!B5Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
félisten
-
félisten
válasz mr.nagy #9295 üzenetére
Kérdésedből nem derült ki korábban, hogy pixelben szeretnéd megadni a szélességet...
Nem igazán értem mi a gond, mivel ha megadod, hogy a Width és Height is pl 50, akkor egy 50x50 pixeles méretben illeszti be a képet. Nálad nem?Mindenki tudja, hogy bizonyos dolgokat nem lehet megvalósítani, mígnem jön valaki, aki erről nem tud, és megvalósítja. (Albert Einstein)
-
félisten
válasz mr.nagy #9297 üzenetére
Itt egy egyszerű kód, ami az A1 "cellába" beilleszt bármilyen képet, 40x40 pixel méretben
Sub Insert_Pic()
Application.ScreenUpdating = False
SelectedPic = Application.GetOpenFilename _
("Képformátumok (*.gif; *.jpg; *.bmp; *.tif),*.gif; *.jpg; *.bmp; *.tif", , "Jelöljön ki egy képet")
If SelectedPic <> False Then
Range("A1").Select
With ActiveSheet
.Pictures.Insert (MyPicture)
.Shapes(.Shapes.Count).Select
End With
With Selection
.ShapeRange.LockAspectRatio = msoFalse
.ShapeRange.Top = ActiveCell.Top
.ShapeRange.Left = ActiveCell.Left
.ShapeRange.Height = 40
.ShapeRange.Width = 40
End With
End If
Application.ScreenUpdating = True
End SubNem láttam a teljes kódod, de feltételezem ez a sor hiányzik belőle (ami a fenti kódban is megtalálható)
.ShapeRange.LockAspectRatio = msoFalseHa ennek az értéke msoTrue, akkor mindegy milyen értéket adsz meg a Width/Height esetén, az eredeti méretben fog bekerülni a kép.
[ Szerkesztve ]
Mindenki tudja, hogy bizonyos dolgokat nem lehet megvalósítani, mígnem jön valaki, aki erről nem tud, és megvalósítja. (Albert Einstein)
-
félisten
-
mr.nagy
tag
válasz mr.nagy #9302 üzenetére
Közben találtam egy megfelelő kódot, közzé teszem hátha másnak is jó lesz:
Sub Insert_Pic()
Dim URL As String
URL = Worksheets("Munka2").Range("A1").Value
Range("A5").Select
ActiveSheet.Pictures.Insert(URL).Select
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.Height = 140
Selection.ShapeRange.Width = 200
Selection.ShapeRange.Rotation = 0#
End SubMinden esetre köszönöm Fire a segítséged!
HMNote10Pro
-
félisten
válasz mr.nagy #10583 üzenetére
Munkalapot alapban nem tud menteni az Excel, ha mentesz, akkor a munkafüzetet mented, ami meg a munkalapok összessége. Makróval az kivitelezhető, hogy egy adott munkalapon bekövetkezett változásokat kimentsen, de akkor gondoskodni kell arról is, hogy azt a legközelebb, a munkafüzet újbóli megnyitásakor be is töltse/módosítsa...
Mindenki tudja, hogy bizonyos dolgokat nem lehet megvalósítani, mígnem jön valaki, aki erről nem tud, és megvalósítja. (Albert Einstein)
-
Delila_1
Topikgazda
válasz mr.nagy #10982 üzenetére
Igen, megoldható. A laphoz kell rendelned a kódot.
Private Sub Worksheet_Change(ByVal Target As Range)
Range("A5").Select
If Intersect(Range("A1"), Target) = "" Then Exit Sub
If Not Intersect(Range("A1"), Target) Is Nothing Then _
Selection.AutoFilter Field:=1, Criteria1:=Range("A1")
End SubProgramozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
Delila_1
Topikgazda
válasz mr.nagy #10984 üzenetére
Most látom, hogy még délelőtt hozzáírtál.
Az 5. sor a címsor? Ha igen, nem kell módosítanod a kódon, ha az már adatsor, akkor a For kezdetű sorban a 6-ot írd át 5-re.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim usor%, sor%
usor% = Range("A65536").End(xlUp).Row
If Not Intersect(Range("A1"), Target) Is Nothing Then
If Target = "" Then
Rows("5:50000").Hidden = False
Else
For sor% = 6 To usor%
If Cells(sor%, 1) <> Cells(1) Then Rows(sor%).Hidden = True
Next
End If
End If
End SubAz A1 cellába történő beíráskor elrejti azokat a sorokat, amik nem egyenlőek annak a tartalmával. A cella törlésekor minden sort felfed.
Abban az esetben, mikor az oszlopban nem található adatot írsz az A1-be, minden sort elrejt, de ekkor is láthatóvá teheted újra a sorokat az A1 tartalmának a törlésével.Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
Delila_1
Topikgazda
válasz mr.nagy #11278 üzenetére
Így gondoltad?
Sub Tizenhat()
Dim sor As Integer, usor As Integer, oszlop As Integer, sor_1 As Integer
oszlop = 3: sor_1 = 2
usor = Range("B65536").End(xlUp).Row
For sor = 13 To usor
If sor_1 < 6 Then
Cells(sor_1, oszlop) = Cells(sor, 2)
sor_1 = sor_1 + 1
Else
sor_1 = 2
oszlop = oszlop + 4
sor = sor - 1
End If
If oszlop = 19 Then
MsgBox "Ide jön a nyomtatás"
'ide jön a nyomtatás
Range("C2:R5").ClearContents
oszlop = 3
End If
Next
End SubProgramozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
Delila_1
Topikgazda
válasz mr.nagy #11280 üzenetére
Nem jó!
Az egyes nyomtatások után kitörli a képleteidet is.A Range("C2:R5").ClearContents helyett Range("C2:C5,G2:G5,K2:K5,O2:O5").ClearContents legyen a törlés sora.
[ Szerkesztve ]
Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
Új hozzászólás Aktív témák
Állásajánlatok
Cég: Ozeki Kft.
Város: Debrecen