MS Excel

Dobrý den,
potřeboval bych pomoct s makrem, které když se klikne na "čudlík" tak makro prověří sloupec pod čudlíkem, a kde bude číslo větší než 0 nakopíruje tyto čísla i s jejich názvem (sloupec A) do jiného listu. Jde mi o to, že mám tabulku se 140 řádkami a potřebuju blbu vzdorně udělat toto překopírování do jiného listu s makrem do dalšího programu.
Děkuju.

Zaslat odpověď >

Strana: 1 2 další »

123456789123456(25.12.2020 23:57)#049263

Sub kopiruj()

Dim i As Integer, j As Integer
j = 1
'zkopíruje A1:A140 pokud > 0
For i = 1 To 140
If Worksheets("List1").Cells(i, 1).Value > 0 Then
Worksheets("List2").Cells(j, 1) = Worksheets("List1").Cells(i, 1).Value
j = j + 1
End If
Next i
End Subcitovat

Ramigas(26.12.2020 8:59)#049264

123456789123456 napsal/a:

Sub kopiruj()

Dim i As Integer, j As Integer
j = 1
'zkopíruje A1:A140 pokud > 0
For i = 1 To 140
If Worksheets("List1").Cells(i, 1).Value > 0 Then
Worksheets("List2").Cells(j, 1) = Worksheets("List1").Cells(i, 1).Value
j = j + 1
End If
Next i
End Sub

Ahoj, děkuju, funguje skoro jak má.
Ještě bych to potřeboval nastavit, že to udělá když to nastavím pro buňky "B1 až B140" tak mi to vypíše i příslušné Buňky v A1 až 140. Jde to vůbec? Tzn., že například v B64 budu mít 0 tak se mi A64 neopíše. Ale v B69 už budu mít hodnotu větší než 0 tak se mi A69 opíše taky..
Děkuju za pomoc.citovat

Jiří497(26.12.2020 13:07)#049266

Pokud se má kopírovat sloupec A na základě B, tak v příkazu if nahraďte číslo 1 číslem 2 If Worksheets("List1").Cells(i, 2).Value > 0 Then citovat

Ramigas(26.12.2020 17:13)#049269

Jiří497 napsal/a:

Pokud se má kopírovat sloupec A na základě B, tak v příkazu if nahraďte číslo 1 číslem 2 If Worksheets("List1").Cells(i, 2).Value > 0 Then

Má se kopírovat sloupec A i B na základě B. Jde to vůbec?
Děkuju.citovat

Jiří497(26.12.2020 17:58)#049270

Samozřejmě, že to jde. A kdybyste to řekl hned na začátku a vložil přílohu, jak to má vypadat, tak už vám to dáno funguje.

Do makra vložte ještě jednou příkaz pro kopírování, jen změňte číslo 1 ( sloupec A) za číslo 2 ( sloupec B): Worksheets("List2").Cells(j, 1) = Worksheets("List1").Cells(i, 1).Value
Worksheets("List2").Cells(j, 2) = Worksheets("List1").Cells(i, 2).Value

Tak snad to zvládnete citovat

Ramigas(26.12.2020 18:27)#049272

Jiří497 napsal/a:

Samozřejmě, že to jde. A kdybyste to řekl hned na začátku a vložil přílohu, jak to má vypadat, tak už vám to dáno funguje.

Do makra vložte ještě jednou příkaz pro kopírování, jen změňte číslo 1 ( sloupec A) za číslo 2 ( sloupec B): Worksheets("List2").Cells(j, 1) = Worksheets("List1").Cells(i, 1).Value
Worksheets("List2").Cells(j, 2) = Worksheets("List1").Cells(i, 2).Value

Tak snad to zvládnete

Funguje, moc děkuju!citovat

elninoslov(26.12.2020 22:50)#049277

Ak sú to susedné bunky, kopírujte ich naraz obe:
Sub kopiruj()
Dim i As Integer, j As Integer

'zkopíruje A1:A140 pokud > 0
For i = 1 To 140
With Worksheets("List1").Cells(i, 2)
If .Value > 0 Then
j = j + 1
Worksheets("List2").Cells(j, 1).Resize(, 2) = .Offset(0, -1).Resize(, 2).Value
End If
End With
Next i
End Sub
A ešte rýchlejšie cez pole (ale tu sa jedná o máličko údajov, takže asi zbytočné...)
Sub kopiruj2()
Dim i As Integer, j As Integer, D(), V()

D = Worksheets("List1").Range("A1:B140").Value
'zkopíruje A1:A140 pokud > 0
For i = 1 To 140
If D(i, 2) > 0 Then
j = j + 1
ReDim Preserve V(1 To 2, 1 To j)
V(1, j) = D(i, 1): V(2, j) = D(i, 2)
End If
Next i
If j > 0 Then Worksheets("List2").Range("A1").Resize(j, 2).Value = Application.Transpose(V)
End Subcitovat

Jiří497(28.12.2020 8:05)#049281

@elninoslov: Jen dotaz ohledně j = j + 1
Je to záměr nebo vám jen vypadlo j = 0? Mám zafixované, že vždy je třeba přiřadit první hodnotu, jinak se program může chovat "divně".
Je jistota, že pokud rovnou uvedu j = j + 1 (aniž bych předtím měl příkaz j = 0), že j = 1?

Jinými slovy, polud mám Dim j as Integer, tak j je automaticky 0? Vždy, za každých okolností?citovat

marjankaj(28.12.2020 13:19)#049282

@iirko
A čo ti bráni vyskúšať to? Spusti aj opakovane.
Public Sub aaa()
Dim j As Integer
MsgBox j
For i = 1 To 10
j = j + 1
Next i
End Subcitovat

Jiří497(28.12.2020 14:33)#049283

To jsem zkusil - teda jen jednou :)
Ale asi to nezvládnu psychicky, abych se na to spoléhal. Jedině, že by to bylo v manuálu - "vždy při deklaraci proměnné se nastaví na 0".
Ale manuál jsem nečetl a hledat se mi to nchce :(citovat

Strana: 1 2 další »

Téma: Makro na kopírování buněk větší než 1

Uživatelské menu

Menu

Formulář Faktura

Formulář Faktura IV

Helios iNuvio

On-line nástroje