VBA Chia dữ liệu 1 sheet thành nhiều sheet

hongphuong1997 · 21/10/18

Nhờ thầy cô và anh chị viết giúp code như file đính kèm

hongphuong1997 · 22/10/18

Bài này khó quá bác Gàcon ơi, giúp cháu với

Ba Tê · 22/10/18

hongphuong1997 đã viết:
Bài này khó quá bác Gàcon ơi, giúp cháu với

Khó là dữ liệu tiếng Việt có dấu, làm sao biết "Chu kỳ 1" là lấy dữ liệu cho sheet "ck1".

hongphuong1997 · 22/10/18

Ba Tê đã viết:
Khó là dữ liệu tiếng Việt có dấu, làm sao biết "Chu kỳ 1" là lấy dữ liệu cho sheet "ck1".

Tức là copy sang đấy bác à

phihndhsp · 22/10/18

hongphuong1997 đã viết:
Bài này khó quá bác Gàcon ơi, giúp cháu với

Bác Gà con(Concogia) ơi, bác gà con à đừng có lo nhậu nữa, tranh thủ giúp em nó giải quyết công việc nha, sẵn tiện ôn lại võ công luôn, không thôi là bị lụt nghề

hongphuong1997 · 22/10/18

phihndhsp đã viết:
Bác Gà con(Concogia) ơi, bác gà con à đừng có lo nhậu nữa, tranh thủ giúp em nó giải quyết công việc nha, sẵn tiện ôn lại võ công luôn, không thôi là bị lụt nghề

hi hi... anh giúp em với anh nhé

HeSanbi · 22/10/18

hongphuong1997 đã viết:
Nhờ thầy cô và anh chị viết giúp code như file đính kèm

Bạn hỏi "Chia dữ liệu thành nhiều Sheet" làm cho người đọc tiêu đề hiểu nhằm
Tôi nghĩ nên là "Sắp xếp lại dữ liệu sang các Sheet"
Mỗi sheet đại diện một Chu kì ( 1 , 2 , 3, ...)
Các hàng 1 thành 1 mảng cùng chu kì thành phần ( 1.1 , 1.2, 1.3 )
Các hàng 2 thành 2 mảng cùng chu kì thành phần
........

hongphuong1997 · 22/10/18

minahnh0011 đã viết:
Bạn hỏi "Chia dữ liệu thành nhiều Sheet" làm cho người đọc tiêu đề hiểu nhằm
Tôi nghĩ nên là "Sắp xếp lại dữ liệu sang các Sheet"
Mỗi sheet đại diện một Chu kì ( 1 , 2 , 3, ...)
Các hàng 1 thành 1 mảng cùng chu kì thành phần ( 1.1 , 1.2, 1.3 )
Các hàng 2 thành 2 mảng cùng chu kì thành phần
........

Vâng ạ, bởi vì em không biết đặt vấn đề như nào?
Anh có làm được không hở anh?
Giúp em với

Ba Tê · 22/10/18

hongphuong1997 đã viết:
Tức là copy sang đấy bác à

Nói vậy mà vẫn chưa hiểu.
Trong sheer cs-1, cái chỗ nào để báo cho biết là nó sẽ copy sang sheet ck1, ck2,....
Bảo anh Bill hiểu viết tắt "Chu kỳ 1" là ck1? Giống như ACE là "Anh chị em"?

hongphuong1997 đã viết:
hi hi... anh giúp em với anh nhé

Chờ anh ấy đi!

HeSanbi · 22/10/18

Bạn sử dụng tạm code này nhé ! Tại tôi lười viết quá
Tôi viết thành một function để bạn dể dàng điều chỉnh độ rộng, số lượng côt, mảng, khoảng cách

fromRng - Đưa vào một đối tượng là range nhé ( not Array)
soCK - số chu kì ( trong file của bạn là 3)
SoArray - Số mảng của mỗi chu kì ( của bạn là 7)
SoCotCK - số cột của mỗi một chu kì ( của 7 array là 9)
SoHang - số hàng để duyệt (16 + 1 , 17 nhé)
KcCot - khoảng cách các mảng theo cột ( 2)
KcHang - khoảng cách theo hàng (2)
stepRow - bước nhảy từ 1 đến 9 theo yêu cầu của bạn.

Các tham số trên quyết định một mảng bạn muốn duyệt qua.

Công việc còn lại là bạn tạo một vòng lặp duyệt qua cột có 5 chu kì của bạn
Trong function dưới có một cách dùng để tham chiếu, là trả lại row và column của range, rồi dùng cell.
nếu bắt gặp thì tham chiếu đến ví dụ: "chu kì 1-1" dùng offset
trong file của bạn thì ví dụ: Sheets("cs-1").cells(1, 1).offset(2 , 5)
arr = getStepCK( Sheets("cs-1").cells(1, 1).offset(2 , 5), 3, 7, 9, 17, 2, 2, 9)

Mã:

Sub test_getStepCK()
    Sheets("Sheet1").[A1:ABZ1000].ClearContents
    Dim arr
    arr = getStepCK(Sheets("cs-1").range("F3"), 3, 7, 9, 17, 2, 2, 9)
    Sheets("Sheet1").[A2].Resize(UBound(arr), UBound(arr, 2)).Value = arr
End Sub
    Function getStepCK(fromRng As Range, _
                    ByVal soCK As Integer, _
                    ByVal SoArray As Integer, _
                    ByVal SoCotCK As Integer, _
                    ByVal SoHang As Integer, _
                    ByVal KcCot As Integer, _
                    ByVal KcHang As Integer, _
                    ByVal stepRow As Integer) As Variant
     
 
        Dim ArrCK1() As Variant, rArr()
        Dim iCK As Long, jCK As Long, m, n
        Dim iTatCaCot As Long: iTatCaCot = SoCotCK * SoArray + SoArray * KcCot
     
        If IsArray(fromRng) Then Debug.Print "fromRng can not be Array": Exit Function
        m = fromRng.Row + soCK * SoHang + (soCK - 1) * KcHang - 1
        n = fromRng.Column + SoArray * SoCotCK + (SoArray - 1) * KcCot - 1

        With Worksheets(fromRng.Parent.Name)
            ArrCK1 = .Range(.Cells(fromRng.Row, fromRng.Column), .Cells(m, n)).Value
            ReDim rArr(1 To SoHang * stepRow, 1 To UBound(ArrCK1, 2) * soCK + KcCot * 2)
            For iCK = 1 To UBound(ArrCK1)
                For jCK = 1 To UBound(ArrCK1, 2)
                    'Chu ki 1 cua Chu Ki
                    If iCK <= SoHang Then
                        rArr(iCK * stepRow - (stepRow - 1), jCK) = ArrCK1(iCK, jCK)
                    End If
                    'Chu ki 2 cua Chu Ki
                    If iCK > SoHang + KcHang And iCK <= SoHang * 2 + KcHang Then
                        rArr((iCK - SoHang - KcHang) * stepRow - (stepRow - 1), jCK + iTatCaCot) = ArrCK1(iCK, jCK)
                    End If
                    'Chu ki 3 cua Chu Ki
                    If iCK > SoHang * 2 + KcHang * 2 Then
                        rArr((iCK - SoHang * 2 - KcHang * 2) * stepRow - (stepRow - 1), jCK + iTatCaCot * 2) = ArrCK1(iCK, jCK)
                    End If
                    'Chu ki 4 cua Chu Ki
                    '......

                Next jCK
            Next iCK
        End With
        getStepCK = rArr

    End Function

hongphuong1997 · 23/10/18

minahnh0011 đã viết:
Bạn sử dụng tạm code này nhé ! Tại tôi lười viết quá
Tôi viết thành một function để bạn dể dàng điều chỉnh độ rộng, số lượng côt, mảng, khoảng cách

fromRng - Đưa vào một đối tượng là range nhé ( not Array)
soCK - số chu kì ( trong file của bạn là 3)
SoArray - Số mảng của mỗi chu kì ( của bạn là 7)
SoCotCK - số cột của mỗi một chu kì ( của 7 array là 9)
SoHang - số hàng để duyệt (16 + 1 , 17 nhé)
KcCot - khoảng cách các mảng theo cột ( 2)
KcHang - khoảng cách theo hàng (2)
stepRow - bước nhảy từ 1 đến 9 theo yêu cầu của bạn.

Các tham số trên quyết định một mảng bạn muốn duyệt qua.

Công việc còn lại là bạn tạo một vòng lặp duyệt qua cột có 5 chu kì của bạn
Trong function dưới có một cách dùng để tham chiếu, là trả lại row và column của range, rồi dùng cell.
nếu bắt gặp thì tham chiếu đến ví dụ: "chu kì 1-1" dùng offset
trong file của bạn thì ví dụ: Sheets("cs-1").cells(1, 1).offset(2 , 5)
arr = getStepCK( Sheets("cs-1").cells(1, 1).offset(2 , 5), 3, 7, 9, 17, 2, 2, 9)

Mã:

Sub test_getStepCK() Sheets("Sheet1").[A1:ABZ1000].ClearContents Dim arr arr = getStepCK(Sheets("cs-1").range("F3"), 3, 7, 9, 17, 2, 2, 9) Sheets("Sheet1").[A2].Resize(UBound(arr), UBound(arr, 2)).Value = arr End Sub Function getStepCK(fromRng As Range, _ ByVal soCK As Integer, _ ByVal SoArray As Integer, _ ByVal SoCotCK As Integer, _ ByVal SoHang As Integer, _ ByVal KcCot As Integer, _ ByVal KcHang As Integer, _ ByVal stepRow As Integer) As Variant Dim ArrCK1() As Variant, rArr() Dim iCK As Long, jCK As Long, m, n Dim iTatCaCot As Long: iTatCaCot = SoCotCK * SoArray + SoArray * KcCot If IsArray(fromRng) Then Debug.Print "fromRng can not be Array": Exit Function m = fromRng.Row + soCK * SoHang + (soCK - 1) * KcHang - 1 n = fromRng.Column + SoArray * SoCotCK + (SoArray - 1) * KcCot - 1 With Worksheets(fromRng.Parent.Name) ArrCK1 = .Range(.Cells(fromRng.Row, fromRng.Column), .Cells(m, n)).Value ReDim rArr(1 To SoHang * stepRow, 1 To UBound(ArrCK1, 2) * soCK + KcCot * 2) For iCK = 1 To UBound(ArrCK1) For jCK = 1 To UBound(ArrCK1, 2) 'Chu ki 1 cua Chu Ki If iCK <= SoHang Then rArr(iCK * stepRow - (stepRow - 1), jCK) = ArrCK1(iCK, jCK) End If 'Chu ki 2 cua Chu Ki If iCK > SoHang + KcHang And iCK <= SoHang * 2 + KcHang Then rArr((iCK - SoHang - KcHang) * stepRow - (stepRow - 1), jCK + iTatCaCot) = ArrCK1(iCK, jCK) End If 'Chu ki 3 cua Chu Ki If iCK > SoHang * 2 + KcHang * 2 Then rArr((iCK - SoHang * 2 - KcHang * 2) * stepRow - (stepRow - 1), jCK + iTatCaCot * 2) = ArrCK1(iCK, jCK) End If 'Chu ki 4 cua Chu Ki '...... Next jCK Next iCK End With getStepCK = rArr End Function

Em cảm ơn anh
Anh ơi sao em không được code hở anh?

CHAOQUAY · 23/10/18

hongphuong1997 đã viết:
Nhờ thầy cô và anh chị viết giúp code như file đính kèm

Dùng code này xem sao
Đây là áp dụng vào việc gì thế bạn

Mã:

Option Explicit
Option Compare Text
Sub ChuKy()
Dim SArr, Res, ShName, CkName
Dim Wsh As Worksheet
Dim i, j, k, x, z, t
ReDim Res(1 To 16 * 9 + 1, 1 To 9)
Application.DisplayAlerts = False
For Each Wsh In Worksheets
    If Wsh.Name <> "cs-1" Then Wsh.Delete
Next Wsh
Application.DisplayAlerts = True
For i = 90 To 318 Step 57
    ShName = Sheet38.Cells(i - 2, 1).Value
    Worksheets.Add(after:=Worksheets(Worksheets.Count)).Name = ShName
    For j = i To i + 38 Step 19
        CkName = Sheet38.Cells(j - 1, 5)
        Sheets(ShName).Cells(6, (j - i) / 19 * 77 + 5) = CkName
        For k = 6 To 72 Step 11
            SArr = Sheet38.Cells(j, k).Resize(17, 9)
            For x = 1 To 17
                z = (x - 1) * 9 + 1
                For t = 1 To UBound(SArr, 2)
                    Res(z, t) = SArr(x, t)
                Next t
            Next x
            With Sheets(ShName)
                If j = i And k = 6 Then
                    .Range("f7").Resize(145, 9) = Res
                Else
                    .Range("xfd7").End(xlToLeft).Offset(, 3).Resize(145, 9) = Res
                End If
            End With
        Next k
    Next j
    Sheets(ShName).Range("a1:xfd1").ColumnWidth = 1.43
    Sheets(ShName).Range("f7:hz151").Columns.AutoFit
Next i
End Sub

hongphuong1997 · 23/10/18

CHAOQUAY đã viết:

Dùng code này xem sao
Đây là áp dụng vào việc gì thế bạn

Mã:

Option Explicit
Option Compare Text
Sub ChuKy()
Dim SArr, Res, ShName, CkName
Dim Wsh As Worksheet
Dim i, j, k, x, z, t
ReDim Res(1 To 16 * 9 + 1, 1 To 9)
Application.DisplayAlerts = False
For Each Wsh In Worksheets
    If Wsh.Name <> "cs-1" Then Wsh.Delete
Next Wsh
Application.DisplayAlerts = True
For i = 90 To 318 Step 57
    ShName = Sheet38.Cells(i - 2, 1).Value
    Worksheets.Add(after:=Worksheets(Worksheets.Count)).Name = ShName
    For j = i To i + 38 Step 19
        CkName = Sheet38.Cells(j - 1, 5)
        Sheets(ShName).Cells(6, (j - i) / 19 * 77 + 5) = CkName
        For k = 6 To 72 Step 11
            SArr = Sheet38.Cells(j, k).Resize(17, 9)
            For x = 1 To 17
                z = (x - 1) * 9 + 1
                For t = 1 To UBound(SArr, 2)
                    Res(z, t) = SArr(x, t)
                Next t
            Next x
            With Sheets(ShName)
                If j = i And k = 6 Then
                    .Range("f7").Resize(145, 9) = Res
                Else
                    .Range("xfd7").End(xlToLeft).Offset(, 3).Resize(145, 9) = Res
                End If
            End With
        Next k
    Next j
    Sheets(ShName).Range("a1:xfd1").ColumnWidth = 1.43
    Sheets(ShName).Range("f7:hz151").Columns.AutoFit
Next i
End Sub

Em cảm ơn anh
CHAOQUAY
đúng roài anh oi, bài này là em lấy giữ liệu để dùng cho bài toán theo dõi chu kỳ mưa trong tháng mà anh

Ba Tê · 23/10/18

Ghi chú cho 1 ô để hiểu "Chu kỳ 1" là đưa qua sheet "ck1".

hongphuong1997 · 23/10/18

Ba Tê đã viết:
Ghi chú cho 1 ô để hiểu "Chu kỳ 1" là đưa qua sheet "ck1".

Ôi, em cảm ơn anh
Ba Tê
Tuyệt vời quá anh oi
Em cảm ơn anh nhé

VBA Chia dữ liệu 1 sheet thành nhiều sheet

hongphuong1997

Thành viên tiêu biểu

File đính kèm

hongphuong1997

Thành viên tiêu biểu

Ba Tê

Cạo Rồi Khỏi Gội

hongphuong1997

Thành viên tiêu biểu

phihndhsp

Thành viên gạo cội

hongphuong1997

Thành viên tiêu biểu

HeSanbi

Nam Nhân✨Hiếu Lễ Nghĩa Trí Tín✨

hongphuong1997

Thành viên tiêu biểu

Ba Tê

Cạo Rồi Khỏi Gội

HeSanbi

Nam Nhân✨Hiếu Lễ Nghĩa Trí Tín✨

hongphuong1997

Thành viên tiêu biểu

CHAOQUAY

Thành viên gắn bó

hongphuong1997

Thành viên tiêu biểu

Ba Tê

Cạo Rồi Khỏi Gội

File đính kèm

hongphuong1997

Thành viên tiêu biểu

Bài viết mới nhất

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Đếm ngược thời gian