< návrat zpět

MS Excel


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

Zaslal/a 25.12.2020 14:51

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ší »
#049263
avatar
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
citovat
#049264
avatar

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
#049266
avatar
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
#049269
avatar

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
#049270
avatar
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
#049272
avatar

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
#049277
elninoslov
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 Sub
citovat
#049281
avatar
@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
#049282
avatar
@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 Sub
citovat
#049283
avatar
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ší »

Uživatelské menu

Nejste přihlášen(a)
avatar\n

Menu

On-line nástroje

Formulář Faktura

Formulář Faktura IV

Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.

Aktivní diskuse

odpocet a storno tl.

PavDD • 28.3. 8:53

odpocet a storno tl.

Začátečník • 26.3. 14:39

odpocet a storno tl.

PavDD • 26.3. 10:22

odpocet a storno tl.

elninoslov • 26.3. 7:50

odpocet a storno tl.

PavDD • 26.3. 7:26

odpocet a storno tl.

elninoslov • 25.3. 22:34

odpocet a storno tl.

Začátečník • 25.3. 15:09