Ahoj všem,
potřeboval bych poradit s jedním makrem v Excelu. V příloze je vložen ukázkový soubor.
Jde o to, že do sloupce C vkládám určitá data (buňky C2:C100000) a ty je potřeba náhodně seřadit a tyto náhodně seřazené data zkopírovat do sloupce F (F2:F100000). Dále data ze sloupce C znova náhodně seřadit a vložit do sloupce G (G2:G100000). Dále data ze sloupce C znova náhodně seřadit a vložit do sloupce H (H2:H100000). A tak pořád dále. Potřebuji dostat 3000 sloupců (F:DKO) kde budou náhodně seřazená data ze sloupce C.
Podařilo se mi udělat makro, které provede první operaci – tj.: náhodně seřadí data ze sloupce C a ty zkopíruje do sloupce F. Teď ale nevím jak dál – jak dostat pokaždé znova seřazená dat do dalších 2999 sloupců.
Děkuji za pomoc a doufám, že jsem to napsal srozumitelně.
Moje vytvořené makro:
Sub Nahodne_poradi_dat()
'
' Nahodne_poradi_dat Makro
'
'
Range("C:D").Select
ActiveWorkbook.Worksheets("List1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("List1").Sort.SortFields.Add Key:=Range("D2:D100000"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("List1").Sort
.SetRange Range("C1:D100000")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("C2:C100000").Select
Selection.Copy
Range("F2").Select
ActiveSheet.Paste
End Sub
Excel VBA - kopírování dat do sloupců Vyřešeno
Excel VBA - kopírování dat do sloupců Vyřešeno
- Přílohy
-
- Nahodne serazeni dat - priklad.xlsm
- (36.94 KiB) Staženo 40 x
-
- Pohlaví:
Re: Excel VBA - kopírování dat do sloupců
Náhodná čísla používáte, takže OK. Pak může nastoupit buď filtr a řazení nebo maticový vzorec. Sto tisíc dat je ale maticový vzorec masakr, takže doporučuju stávající postup, ovládání filtru přes VBA a kopírování na jiný list a do patřičného sloupce s využitím .Offset.
Re: Excel VBA - kopírování dat do sloupců
Zkus něco takového:
Kód: Vybrat vše
Sub Nahodne_poradi_dat2()
Dim V() As Variant
Dim N1 As Long, N2 As Long
Dim X As Long
Dim i As Long
Dim ss As Variant
Dim cil As Range
V = Range("C2:C101").Value2 ' rozsah zdrojových dat
N1 = LBound(V, 1)
N2 = UBound(V, 1)
Set cil = Range("F2").Resize(N2, 1)
For s = 1 To 10 ' nastav počet sloupců
For i = N2 To N1 + 1 Step -1
X = Int(Rnd() * (i - N1 + 1)) + N1
ss = V(X, 1)
V(X, 1) = V(i, 1)
V(i, 1) = ss
Next i
cil.Value2 = V
Set cil = cil.Offset(0, 1)
Next ' sloupec
End Sub
-
- Pohlaví:
Re: Excel VBA - kopírování dat do sloupců
No, něco jsem si zkusil...
http://leteckaposta.cz/419941086
Bohužel to kolabuje cca na 1300 sloupcích. Nemám pravděpodobně dost prostředků na tuhle megalomanskou úlohu (100 000 řádků x 3 000 sloupců). I když ta data vygenerujete, v Excelu je bez pořádné výbavy nikdy nezpracujete.
http://leteckaposta.cz/419941086
Bohužel to kolabuje cca na 1300 sloupcích. Nemám pravděpodobně dost prostředků na tuhle megalomanskou úlohu (100 000 řádků x 3 000 sloupců). I když ta data vygenerujete, v Excelu je bez pořádné výbavy nikdy nezpracujete.
Re: Excel VBA - kopírování dat do sloupců
Ahojte, oběma moc děkuju za reakci a za pomoc
To xlnc:
Moc děkuju za soubor s makrem-dělá to přesně co potřebuju Můj počítač také neudržel 100000 řádků, ale po redukci na 50000 (což pro většinu případů bude stačit je to OK.
Mám ještě jeden dotaz. Seřazené hodnoty se kopírují do Listu2 od buňky A1. V Listu 2 bych na začátku potřeboval jeden prázdný sloupec a řádek - tzn. aby se data nakopírovaly až od buňky B2. Můžete mi pomoci jak upravit makro, aby to takto fungovalo?
Zkoušel jsem upravit Cil v makru takto: " Set wshListCil = Worksheets("List2!B2") " , ale to nefunguje.
Díky za pomoc
Makro:
To xlnc:
Moc děkuju za soubor s makrem-dělá to přesně co potřebuju Můj počítač také neudržel 100000 řádků, ale po redukci na 50000 (což pro většinu případů bude stačit je to OK.
Mám ještě jeden dotaz. Seřazené hodnoty se kopírují do Listu2 od buňky A1. V Listu 2 bych na začátku potřeboval jeden prázdný sloupec a řádek - tzn. aby se data nakopírovaly až od buňky B2. Můžete mi pomoci jak upravit makro, aby to takto fungovalo?
Zkoušel jsem upravit Cil v makru takto: " Set wshListCil = Worksheets("List2!B2") " , ale to nefunguje.
Díky za pomoc
Makro:
Kód: Vybrat vše
Sub Makro1()
Dim wshListZdroj As Worksheet
Dim wshListCil As Worksheet
Dim rngOblastDat As Range
Dim i As Integer
Application.ScreenUpdating = False
'wshListZdroj má nastaven ruční přepočet
Set wshListZdroj = Worksheets("List1")
Set wshListCil = Worksheets("List2")
'oblast dat pro kopírování
Set rngOblastDat = wshListZdroj.Range("B1:B50000")
For i = 1 To 3000
Application.StatusBar = "Zpracovávám " & i & " záznam."
'přepočet listu
wshListZdroj.Calculate
'a setřídění
With wshListZdroj.Sort
.SetRange Range("A1:B50000")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'kopie dat do cílového listu
wshListCil.Cells(1, i).Resize(50000, 1).Value = rngOblastDat.Value
Next i
Application.StatusBar = False
Application.ScreenUpdating = True
End Sub
-
- Pohlaví:
Re: Excel VBA - kopírování dat do sloupců
Kód: Vybrat vše
'kopie dat do cílového listu
wshListCil.Cells(2, i + 1).Resize(50000, 1).Value = rngOblastDat.Value
Re: Excel VBA - kopírování dat do sloupců
To xlnc:
Super práce, moc děkuju :)
Super práce, moc děkuju :)
-
- Mohlo by vás zajímat
- Odpovědi
- Zobrazení
- Poslední příspěvek
-
- 9
- 2074
-
od MK_Vs
Zobrazit poslední příspěvek
02 lis 2023 09:26
-
- 3
- 1909
-
od Melvidor
Zobrazit poslední příspěvek
21 črc 2023 08:41
-
-
Obnoveni ztracenych fotek z telefonu pri kopirovani do pc
od Dizzy66 » 21 led 2024 17:08 » v Vše ostatní (sw) - 2
- 1118
-
od šulda
Zobrazit poslední příspěvek
23 úno 2024 07:12
-
-
-
Libre Office Calc - Divné chování při kopírování textu Příloha(y)
od EZumrova » 02 dub 2024 08:12 » v Kancelářské balíky - 14
- 1971
-
od kecalek
Zobrazit poslední příspěvek
05 dub 2024 19:11
-
-
- 16
- 6238
-
od mirekol
Zobrazit poslední příspěvek
20 říj 2023 08:31
Kdo je online
Uživatelé prohlížející si toto fórum: Žádní registrovaní uživatelé a 3 hosti