Temat: rozdzielenie arkuszy

witam serdecznie

mam nie maly jak dla mnie problem, moze ktorys z forumowiczow bedzie wiedzial jak go rozwiazac. Mam 3 arkusze xls w kazdym 3 kolumny po 65000 wierszy(dane to liczby w zakresach -800/800). Problem polega w tym iz musze je rozdzielic na arkusze po 1000 wierszy. Bardzo prosze o pomoc.

Temat: rozdzielenie arkuszy

65 razy ctrl+c / ctrl+v ?

Temat: rozdzielenie arkuszy

3 x 65 ctrl+c/ctrl+v + zapis = masakra

nie ma latwiejszego sposobu ?

Temat: rozdzielenie arkuszy

pewnie da się makrem, ale też trzeba czasu aby go napisać, nie wiem czy dla przeciętnego użytkownika Excela nie dłużej niż 65x powtórzona czynność powyżej :)Darek Jabłoński edytował(a) ten post dnia 17.06.10 o godzinie 08:57

Temat: rozdzielenie arkuszy

Bosh, co za czasy;). Jak byłem młody to student siadał i przeklejał, a teraz do byle pierdnięcia makro;)

Chłopie, podzielić na 65 części to z odbezpieczonym granatem w dupie da radę ręcznie.

Nie wiem dokładnie czy o to Ci chodzi (arkusz to "zakładka", cały plik excela to skoroszyt), ale w ramach programu zachęcania ludzi do nauki excela masz tutej:

Sub temp()

Dim SourceWorkbook As Workbook

Dim SourceSheet As Worksheet

Dim DestWorkbook As Workbook

Dim DestSheet As Worksheet

Dim SOurceRange As Range

Dim HeaderRange As Range



Dim n As Long



Application.ScreenUpdating = False

Set SourceWorkbook = ActiveWorkbook

Set SourceSheet = ActiveSheet

Set HeaderRange = Range(Cells(1, 1), Cells(1, 3))





For n = 0 To 64

    Set DestWorkbook = Workbooks.Add

    Set DestSheet = DestWorkbook.Worksheets(1)

    SourceSheet.Parent.Activate

    SourceSheet.Activate

    Set SOurceRange = Range(Cells(n * 1000 + 2, 1), Cells((n + 1) * 1000 + 2, 3))

    HeaderRange.Copy Destination:=DestSheet.Cells(1, 1)

    SOurceRange.Copy Destination:=DestSheet.Cells(2, 1)

    DestWorkbook.SaveAs (Replace(SourceWorkbook.Name, ".xls", " part " & n + 1 & ".xls"))

    DestWorkbook.Close

Next n



End Sub

Jeżeli chcesz dzielić nie na pliki tylko na zakładki to jedna czy dwie linijki do podmiany, ale to w ramach pracy własnej;)

Temat: rozdzielenie arkuszy

Swoją drogą - chciałbym wiedzieć jaki jest cel takiego dzielenia;)

Temat: rozdzielenie arkuszy

Je też trochę podzieliłem. :-)

Zakładam, że tabele posiadają nagłówek.

Sub Podzial()

  Dim ActWks        As Worksheet

  Dim Wks           As Worksheet

  Dim Tabela        As Range

  Dim LbaArkuszy    As Integer

  Dim i             As Integer

  Dim DzielCo       As Long

  Dim Dane          As Range



  DzielCo = 1000

  

  Application.ScreenUpdating = False

  

  Set ActWks = ActiveSheet

  Set Tabela = ActWks.UsedRange

  Set Dane = Tabela.Offset(1).Resize(Tabela.Rows.Count - 1)



  LbaArkuszy = IIf(Dane.Rows.Count Mod DzielCo = 0, Dane.Rows.Count / DzielCo, Dane.Rows.Count / DzielCo + 1)



  With ActiveWorkbook

    For i = 1 To LbaArkuszy

      Set Wks = .Worksheets.Add(After:=.Worksheets(.Worksheets.Count))

      

      On Error Resume Next

      Wks.Name = ActWks.Name & " <" & i & ">"

      On Error GoTo 0

      

      Tabela.Rows(1).Copy Wks.Cells(1, 1)

      

      If i < LbaArkuszy Then

        Dane.Rows((i - 1) * DzielCo + 1 & ":" & i * DzielCo).Copy Wks.Cells(2, 1)

      Else

        Dane.Rows((i - 1) * DzielCo + 1 & ":" & Dane.Rows.Count).Copy Wks.Cells(2, 1)

      End If

    Next i

  End With

  

  ActWks.Activate

  

  Application.ScreenUpdating = True

  

  Set ActWks = Nothing

  Set Tabela = Nothing

  Set Dane = Nothing

  

End Sub

Ale niezły jest patent pana Wojtka. :-)

ArtikArtur K. edytował(a) ten post dnia 17.06.10 o godzinie 10:05

Temat: rozdzielenie arkuszy

Maciek Głuszak:
Bosh, co za czasy;). Jak byłem młody to student siadał i przeklejał, a teraz do byle pierdnięcia makro;)

Chłopie, podzielić na 65 części to z odbezpieczonym granatem w dupie da radę ręcznie.

Nie wiem dokładnie czy o to Ci chodzi (arkusz to "zakładka", cały plik excela to skoroszyt), ale w ramach programu zachęcania ludzi do nauki excela masz tutej:

Sub temp()

Dim SourceWorkbook As Workbook

Dim SourceSheet As Worksheet

Dim DestWorkbook As Workbook

Dim DestSheet As Worksheet

Dim SOurceRange As Range

Dim HeaderRange As Range



Dim n As Long



Application.ScreenUpdating = False

Set SourceWorkbook = ActiveWorkbook

Set SourceSheet = ActiveSheet

Set HeaderRange = Range(Cells(1, 1), Cells(1, 3))





For n = 0 To 64

    Set DestWorkbook = Workbooks.Add

    Set DestSheet = DestWorkbook.Worksheets(1)

    SourceSheet.Parent.Activate

    SourceSheet.Activate

    Set SOurceRange = Range(Cells(n * 1000 + 2, 1), Cells((n + 1) * 1000 + 2, 3))

    HeaderRange.Copy Destination:=DestSheet.Cells(1, 1)

    SOurceRange.Copy Destination:=DestSheet.Cells(2, 1)

    DestWorkbook.SaveAs (Replace(SourceWorkbook.Name, ".xls", " part " & n + 1 & ".xls"))

    DestWorkbook.Close

Next n



End Sub

Jeżeli chcesz dzielić nie na pliki tylko na zakładki to jedna czy dwie linijki do podmiany, ale to w ramach pracy własnej;)

nigdy exelem się nie interesowałem, dziękuje za skrypt, działa wyśmienicie lecz dzieli na pliki po 1000 wierszy z 3 kolumnami, to już szczegół bo i tak zaoszczędziłeś mi dużo pracy. Dokładniej jak już ktoś pytał to są to sygnały z silnika wirnikowego, robię analizę falkową owych sygnałów (magisterka)

pozdrawiam