vbamania.pl
login:
hasło:
 
  *Rejestracja *Zapomniane hasło
 Dziś jest poniedziałek, 29 kwietnia 2024 roku.
Ustaw jako stronę startową Ulubione Napisz
PowrótPowrót do serwisu  RegulaminRegulamin rssRSS

  tytuł wątku:
Wątki dyskusji

[Makro] Dzielenie pliku wg założeń


otwartyotwarty rozpoczął: zielu postów: 5



napisał: zielu
postów: 3


umieszczony:
9 listopada 2012
13:11

  
Dzięki bardzo :) działa świetnie
napisał: Trebor
postów: 1209


umieszczony:
7 listopada 2012
16:10

  
Najprościej wprowadzić dodatkowe zliczanie za każdym obrotem pętli.
Sub Zielu1()
Dim nagłówki As Range, od_którego As Long, po_ile As Integer, nazwa As String
Dim i As Long, pierwsza As Integer, ile As Long, licznik As Integer
With ThisWorkbook.Sheets(1)
Set nagłówki = .Range("A1:CA3") ' zmieniłem zakres kolumn na odpowiedni dla mnie
od_którego = 4
po_ile = 100
pierwsza = nagłówki.Rows.Count + 1
nazwa = "Aktual_" & Format(Now, "yyyymmdd") & "_" ' dodane podkreślniki
ile = .Cells(.Rows.Count, 1).End(xlUp).Row
licznik = 0

For i = od_którego To ile Step po_ile
licznik = licznik + 1
Workbooks.Add
nagłówki.Copy Cells(1, 1)
.Range(.Cells(i, 1), .Cells(i + po_ile - 1, 50)).Copy Cells(pierwsza, 1) ' ustawiłem zakres kolumn kopiowanych - 50
If ile < i + po_ile - 1 Then .Cells(ile, 1).Interior.Color = vbRed Else .Cells(i + po_ile - 1, 1).Interior.Color = vbRed
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & nazwa & Format(licznik, "00"), FileFormat:=xlExcel8
ActiveWorkbook.Close
Next i
End With
Set nagłówki = Nothing

End Sub

napisał: zielu
postów: 3


umieszczony:
7 listopada 2012
09:48

  
Dziękuję bardzo za odpowiedź, dokonałem paru zmian, mam nadzieję, że nic nie pomieszałem

Sub Zielu()
Dim nagłówki As Range, od_którego As Long, po_ile As Integer, nazwa As String
Dim i As Long, pierwsza As Integer, ile As Long
With ThisWorkbook.Sheets(1)
Set nagłówki = .Range("A1:CA3") ' zmieniłem zakres kolumn na odpowiedni dla mnie
od_którego = 4
po_ile = 100
pierwsza = nagłówki.Rows.Count + 1
nazwa = "Aktual_" & Format(Now, "yyyymmdd") & "_" ' dodane podkreślniki
ile = .Cells(.Rows.Count, 1).End(xlUp).Row
For i = od_którego To ile Step po_ile

Workbooks.Add
nagłówki.Copy Cells(1, 1)
.Range(.Cells(i, 1), .Cells(i + po_ile - 1, 50)).Copy Cells(pierwsza, 1) ' ustawiłem zakres kolumn kopiowanych - 50
If ile < i + po_ile - 1 Then .Cells(ile, 1).Interior.Color = vbRed Else .Cells(i + po_ile - 1, 1).Interior.Color = vbRed
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & nazwa & i, FileFormat:=xlExcel8
ActiveWorkbook.Close
Next i
End With
Set nagłówki = Nothing

End Sub



Utknąłem jednak przy wierszu:

For i = od_którego To ile Step po_ile



rozumiem, że ta linijka odpowiada za naliczanie kolejnych numerów do nazwy, w tej chwili w nazwie wywala coś takiego "Aktual_20121107_104" z czego wynika że 4 jest początkową liczbą a krok = 100, chciałbym to poprawić aby liczenie zaczynało się od liczby którą określę np. 01 i krok wynosił 01 co da nam pliki w postaci "Aktual_20121107_01" - "Aktual_20121107_99"
napisał: Trebor
postów: 1209


umieszczony:
6 listopada 2012
19:47

  
Pobaw się poniższym
Sub Zielu()
Dim nagłówki As Range, od_którego As Long, po_ile As Integer, nazwa As String
Dim i As Long, pierwsza As Integer, ile As Long
With ThisWorkbook.Sheets(1)
Set nagłówki = .Range("A1:C3")
od_którego = 4
po_ile = 100
pierwsza = nagłówki.Rows.Count + 1
nazwa = "Aktual" & Format(Now, "yyyymmdd")
ile = .Cells(.Rows.Count, 1).End(xlUp).Row
For i = od_którego To ile Step po_ile

Workbooks.Add
nagłówki.Copy Cells(1, 1)
.Range(.Cells(i, 1), .Cells(i + po_ile - 1, 3)).Copy Cells(pierwsza, 1)
If ile < i + po_ile - 1 Then .Cells(ile, 1).Interior.Color = vbRed Else .Cells(i + po_ile - 1, 1).Interior.Color = vbRed
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & nazwa & i, FileFormat:=xlExcel8
ActiveWorkbook.Close
Next i
End With
Set nagłówki = Nothing

End Sub

napisał: zielu
postów: 3


umieszczony:
6 listopada 2012
09:35

  
Jako, że to mój startowy post w pierwszych słowach chciałbym się przywitać :)

A teraz do rzeczy... Próbowałem bezowocnie znaleźć makro które pozwoli mi dzielić arkusz Excel na pliki wg zmiennych, które będę w stanie określić w kodzie.

Stałe:
- Kopiowane będą całe wiersze w niezmienionej postaci
- Zapisywanie w postaci plików .xls
- Zapisywanie w folderze w którym plik się znajduje
- Zmiana koloru wiersza, która oznaczać będzie podział arkusza na poszczególne pliki (np. wg zmiennych wyznaczonych poniżej: po utworzeniu nowego pliku z danych w wierszach od W4:W104, wiersz W104 zostałby zaznaczony kolorem, następnie W204, W304, W404... itd aż do końca danych)

Zmienne:
- Określenie nagłówka, który będzie wpisywany w każdym nowo utworzonym pliku (np. W1:W3)
- Określenie początku danych które mają być dzielone (np. W4)
- Budowa składowych nazwy (Pliki będą posiadały nazwy np. AKTUAL_20121106_01_, z czego "AKTUAL_20121106_" byłby treścią którą chciałbym móc określić, a "01" wartością ustawianą automatycznie dla kolejnych plików.
- Określenie zakresu kopiowania, ilości linijek (np. 100)

Mam nadzieję, że znajdzie się jakaś dobra dusza, która będzie mi w stanie pomóc :)

Pozdrawiam i z góry dziękuje


<-wstecz  1  dalej->
wszystkich stron: 1


Sortuj posty: z