< návrat zpět

MS Excel


Téma: potřebuji vybrat nesouvisející buňky rss

Zaslal/a 14.3.2018 10:34

tohle nefunguje
a = 4
Set Oblast = (Range("b" & a), Range("c", 4), Range("f", 4), Range("g", 4)) 'výběr buněk
Oblast.Copy

Zaslat odpověď >

#039837
avatar
Zkus to takto:
Set oblast = Union(Range("B4:C4"), Range("F4:G4"))
oblast.Copy

nebo s definovaným řádkem složitěji
a = 4
Set oblast = Union(Range(Cells(a, 2), Cells(a, 3)), Range(Cells(a, 6), Cells(a, 7)))
oblast.Copy
citovat
#039838
avatar
Set Oblast = Range("B" & a & ",C4,F4,G4").Select
Tak to zkus takto. 2citovat
#039839
elninoslov
Set Oblast = Union(Range("B" & a), Range("C4"), Range("F4"), Range("G4"))
Len z mobilu, snad som sa nepomylil. Kazdopadne ale myslim, ze viacnasobna oblast sa kopirovat tusim neda. Bude mozno treba po jednej podoblasti Area. Skuste, pripadne ked budem pri PC...

Edit: Kym som to ja natukal, us to tu mate 1citovat
#039843
avatar
Děkuji za odpovědi,jenže já potřebuji, aby se v cyklu měnily jednotlivé buňky.Potřebuji makro a ne to vybírat ručně.

for a=1 to 30
Set Oblast = (Range("B" & a),(Range("D" & a) atd
next

range(sloupec B & řádek a)citovat
#039845
avatar

sowda napsal/a:

Děkuji za odpovědi,jenže já potřebuji, aby se v cyklu měnily jednotlivé buňky.Potřebuji makro a ne to vybírat ručně.

for a=1 to 30
Set Oblast = (Range("B" & a),(Range("D" & a) atd
next

range(sloupec B & řádek a)


Mám tomu rozumět tak, že ani jedna odpověď není správná? 8citovat
#039846
avatar
tak už jsem to dal dohromady, moc děkuji za trpělivost 1
je to takhle:

Sub vyber()
Dim Oblast As Range
b = 5
For a = 5 To 41
Range("G" & a).Select
If Right(Range("G" & a), 1) = "0" Or Right(Range("G" & a), 1) = "5" Then
Set Oblast = Application.Union(Range("b" & a), Range("c" & a), Range("f" & a), Range("g" & a)) 'výběr buněk
Oblast.Copy
Range("J" & b).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
b = b + 1
End If
Next
Range("a1").Select
End Subcitovat
#039848
elninoslov
Ja by som to urobil určite cez polia:
Sub VyberKopiruj()
Dim Zdroj(), Ciel(), a As Long, Pocet As Long, PCiel As Long
Const Zaciatok = 5
Const Koniec = 41

Pocet = Koniec - Zaciatok + 1
ReDim Zdroj(1 To Pocet, 1 To 6)

With ActiveSheet
Zdroj = .Cells(Zaciatok, 2).Resize(Pocet, 6).Value2
.Cells(Zaciatok, 10).Resize(Pocet, 4).ClearContents

For a = 1 To Pocet
If Right$(Zdroj(a, 6), 1) = "0" Or Right$(Zdroj(a, 6), 1) = "5" Then
PCiel = PCiel + 1
ReDim Preserve Ciel(1 To 4, 1 To PCiel)
Ciel(1, PCiel) = Zdroj(a, 1): Ciel(2, PCiel) = Zdroj(a, 2)
Ciel(3, PCiel) = Zdroj(a, 5): Ciel(4, PCiel) = Zdroj(a, 6)
End If
Next a

If PCiel > 0 Then .Cells(Zaciatok, 10).Resize(PCiel, 4).Value2 = Application.Transpose(Ciel)
End With
End Sub

A ak nechcete rýchle polia, tak potom určo použite aspoň kopírovanie buniek naraz:
Sub VyberKopiruj2()
Dim a As Long, Oblast As Range
Const Zaciatok = 5
Const Koniec = 41

With ActiveSheet
.Cells(Zaciatok, 10).Resize(Koniec - Zaciatok + 1, 4).ClearContents

For a = Zaciatok To Koniec
If Right$(.Cells(a, 7), 1) = "0" Or Right$(.Cells(a, 7), 1) = "5" Then
If Oblast Is Nothing Then Set Oblast = Union(.Cells(a, 2).Resize(, 2), .Cells(a, 6).Resize(, 2)) Else Set Oblast = Union(Oblast, .Cells(a, 2).Resize(, 2), .Cells(a, 6).Resize(, 2))
End If
Next a

If Not Oblast Is Nothing Then Oblast.Copy: .Cells(Zaciatok, 10).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
.Cells(1, 1).Activate
End With
End Sub
Příloha: zip39848_kopiruj-s-0-a-5-na-konci.zip (19kB, staženo 6x)
citovat
#039849
avatar
Tak to mi to mé řešení připadá jednodušší, ale i to Vaše si uložím. Děkujicitovat

Uživatelské menu

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

Menu

On-line nástroje

Formulář Faktura

Formulář Faktura III

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

Aktivní diskuse

VBA odemknutí a zamknutí sešitu

xlnc • 19.9. 20:24

VBA odemknutí a zamknutí sešitu

Stalker • 19.9. 10:54

VBA odemknutí a zamknutí sešitu

ambraa • 19.9. 10:04

VBA automatické zamknutí buňky s podmínkou

pohis • 17.9. 18:47

Aktivace makra bunkou

Zbygi • 17.9. 14:36

VBA automatické zamknutí buňky s podmínkou

pohis • 17.9. 10:41

VBA automatické zamknutí buňky s podmínkou

Stalker • 17.9. 10:06