< návrat zpět
MS Excel
Téma: Pomoc se vzorcem VBA 
Zaslal/a Plavacek 11.7.2014 9:15
Zdravím, potřeboval bych pomoc s upravením vzorce. Už si nevím rady.
Mám ve sloupci A texty a ve sloupcích E:SA mám jednicky až do řádku 1745. Potřebuju, aby se vypsali ty texty, u kterých je v jednotlivých sloupcích jednička do E:SA 1748. (Tedy pro každý sloupec)
Mám k dispozici vzorec VBA, který to dokáže udělat pro jeden sloupec E ... mohli byste mi ale pomoct s tím, aby to bylo pro všechny sloupce? Díky.
Sub Vypis()
Dim Numbers() As Variant
Dim Texts() As Variant
Dim List() As Variant
Dim CountNumbers As Long
Dim i As Long, j As Long
With ActiveSheet
Texts = .Range("A3:A1745").Value
Numbers = .Range("E3:E1745").Value2
CountNumbers = WorksheetFunction.CountIf(ActiveSheet.Range("E3:E1745"), "1")
If CountNumbers = 0 Then GoTo TheEND
ReDim List(1 To CountNumbers, 1 To 1)
j = 0
For i = LBound(Numbers) To UBound(Numbers)
If Numbers(i, 1) = 1 Then
j = j + 1
List(j, 1) = Texts(i, 1)
If j = CountNumbers Then Exit For
End If
Next
.Range("E1748").Resize(CountNumbers, 1).Value = List
End With
TheEND:
End Sub
Plavacek(14.7.2014 14:57)#020520 
Dingo napsal/a:
TAK JEŠTĚ JEDNOU. Se vzorovým souborem jsem udělal JEN toto: smazal původní makro, nakopíroval nové makro z mého příspěvku z 11.7., zeditoval chybu tam, kde je řádek rozdělený podtržítkem a FUNGUJE to.Příloha: 20511_sample35.zip
Jo, máš pravdu, funguje to dobře, díky :)
Chtěl bych se zeptat. Když bych potřeboval změnit rozsahy pro jiný soubor, tak jak to udělat? Změnil jsem co sem mohl, ale vypisuje to jen po sloupec M.
Přikládám kód zde:
Sub Vypis()
Dim Numbers() As Variant
Dim Texts() As Variant
Dim List() As Variant
Dim CountNumbers As Long
Dim i As Long, j As Long, k As Long
With ActiveSheet
For k = 5 To 495
Texts = .Range("A4:A2098").Value
Numbers = .Range(Cells(4, k), Cells(2098, k)).Value2
CountNumbers = WorksheetFunction.CountIf(ActiveSheet _
.Range(Cells(4, k), Cells(2098, k)), "1")
If CountNumbers = 0 Then GoTo TheEND
ReDim List(1 To CountNumbers, 1 To 1)
j = 0
For i = LBound(Numbers) To UBound(Numbers)
If Numbers(i, 1) = 1 Then
j = j + 1
List(j, 1) = Texts(i, 1)
If j = CountNumbers Then Exit For
End If
Next i
.Cells(2100, k).Resize(CountNumbers, 1).Value = List
Next k
End With
TheEND:
End SubcitovatDingo(14.7.2014 20:57)#020525 To je divné, mě ten tvůj kód z předchozího příspěvku funguje pro všechny sloupce E:SA, v řádcích 4:2098 a vypisuje do řádku 2100.
Do přílohy jsem to trochu upravil. Makro je v Module1. Tam se obvykle dává, ne do Listu, i když i tam funguje.
Jsou tam extra řádky pro zadání rozsahu. Není to vstupem (Input) po spuštění, ale musíš přepsat přímo v kódu řádky a sloupce, tam, kde je to poznámkou označené. Vyzkoušej.
Příloha: 
20525_sample35.zip (81kB, staženo 12x) citovatmarjankaj(14.7.2014 23:22)#020527 No ťažko takto naslepo, keď to nedáš s prílohou. Možno máš stlpec N celý prázdny.
citovatDingo(15.7.2014 6:31)#020528 Marjankaj, nic ve zlém, on už dal přílohu, dostal i odpověď. Tvoje příspěvky jsou značně opožděné a jen matou tazatele.
citovatmarjankaj(15.7.2014 9:42)#020531 Dingo napsal/a:
Marjankaj, nic ve zlém, on už dal přílohu, dostal i odpověď. Tvoje příspěvky jsou značně opožděné a jen matou tazatele.
No keby si to poriadne čítal, tak určite narazíš aj na toto z (14.7.2014 14:57)
Jo, máš pravdu, funguje to dobře, díky :)
Chtěl bych se zeptat. Když bych potřeboval změnit rozsahy
pro jiný soubor, tak jak to udělat? Změnil jsem co sem mohl, ale vypisuje to jen po sloupec M.
citovatPlavacek(15.7.2014 11:10)#020532 Dingo napsal/a:
To je divné, mě ten tvůj kód z předchozího příspěvku funguje pro všechny sloupce E:SA, v řádcích 4:2098 a vypisuje do řádku 2100.
Do přílohy jsem to trochu upravil. Makro je v Module1. Tam se obvykle dává, ne do Listu, i když i tam funguje.
Jsou tam extra řádky pro zadání rozsahu. Není to vstupem (Input) po spuštění, ale musíš přepsat přímo v kódu řádky a sloupce, tam, kde je to poznámkou označené. Vyzkoušej.Příloha: 20525_sample35.zip
Ahoj, už sem na to přišel proč to tak dělá. Ve sloupci M nebyly žádné jedničky, tak se ten program ukončil :).
Každopádně díky, moc si mi pomohl a zároveň o dost vše usnadnil
citovatmarjankaj(15.7.2014 11:32)#020533 @Plavacek
No vidíš, keby si dal ten zošit celý, tak by Dingo na to takisto prišiel.
Takto sa bavíte jeden o koze a druhý o voze.
Stačí iba prehodiť riadky
TheEND:
Next k
End With
End Sub
citovat
RSS nejnovější články