MS Excel

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ěď >

Dingo(14.3.2018 11:24)#039837

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.Copycitovat

Rejpal(14.3.2018 11:24)#039838

Set Oblast = Range("B" & a & ",C4,F4,G4").Select
Tak to zkus takto.

citovat

elninoslov(14.3.2018 11:33)#039839

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

citovat

sowda(14.3.2018 12:52)#039843

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

Rejpal(14.3.2018 13:20)#039845

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á?

citovat

Anonym(14.3.2018 13:40)#039846

tak už jsem to dal dohromady, moc děkuji za trpělivost

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

elninoslov(14.3.2018 15:15)#039848

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: zip

39848_kopiruj-s-0-a-5-na-konci.zip (19kB, staženo 22x)

citovat

sowda(14.3.2018 15:56)#039849

Tak to mi to mé řešení připadá jednodušší, ale i to Vaše si uložím. Děkujicitovat

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

Uživatelské menu

Menu

Formulář Faktura

Formulář Faktura IV

Helios iNuvio

On-line nástroje