Nhờ viết code VBA tổng hợp dữ liệu từ sheet này sang sheet khác (1 người xem)

[kaka01]

Chào các anh chị và các bạn diễn đàn GPE!
em có dữ liệu cần tổng hợp từ sheet Dulieu sang sheet TH (như file đính kèm)
cụ thể: Sheet Dulieu có 17 cột copy sang sheet TH với yêu cầu
- Mục dữ liều ngày cột A Sheet Dulieu điền vào cột A sheet TH(Chuyển định dạng từ dd/mm/yyy-> mm/dd/yyyy)
* Số dòng trong một ngày của mỗi máy khác nhau.
* Các ngày cách nhau bằng một số dòng trống
- Dữ liệu máy(M2,M3,OS,M5,M6,M7) cũng ở cột A Sheet Dulieu điền vào cột D sheet TH theo ngày tương ứng
- Các cột từ B Sheet Dulieu điền vào cột E:S sheet TH
Không biết với dữ liệu và yêu cầu trên có tổng hợp bằng code được không?
Nếu được nhờ các anh chị viết giúp!
Xin cảm ơn!

 

[kaka01]

Có anh chị nào giúp em bài toán trên không ạ?

 

[HieuCD]

Chào các anh chị và các bạn diễn đàn GPE!
em có dữ liệu cần tổng hợp từ sheet Dulieu sang sheet TH (như file đính kèm)
cụ thể: Sheet Dulieu có 17 cột copy sang sheet TH với yêu cầu
- Mục dữ liều ngày cột A Sheet Dulieu điền vào cột A sheet TH(Chuyển định dạng từ dd/mm/yyy-> mm/dd/yyyy)
* Số dòng trong một ngày của mỗi máy khác nhau.
* Các ngày cách nhau bằng một số dòng trống
- Dữ liệu máy(M2,M3,OS,M5,M6,M7) cũng ở cột A Sheet Dulieu điền vào cột D sheet TH theo ngày tương ứng
- Các cột từ B Sheet Dulieu điền vào cột E:S sheet TH
Không biết với dữ liệu và yêu cầu trên có tổng hợp bằng code được không?
Nếu được nhờ các anh chị viết giúp!
Xin cảm ơn!

Sub TongHop()
  Dim sArr(), Res()
  Dim i As Long, k As Long, j As Byte, eRow As Long
  Dim tmp, ngay, may As String
  With Sheets("Dulieu")
    eRow = .Range("C" & Rows.Count).End(xlUp).Row
    If eRow < 5 Then MsgBox ("Khong co du lieu"): Exit Sub
    sArr = .Range("A3:P" & eRow).Value
    eRow = UBound(sArr)
  End With
  ReDim Res(1 To eRow, 1 To UBound(sArr, 2) + 3)
  k = -1
  For i = 1 To eRow
    tmp = sArr(i, 1)
    If Len(tmp) = 10 And Mid(tmp, 3, 1) = "/" Then
      ngay = DateSerial(CInt(Mid(tmp, 7, 4)), CInt(Mid(tmp, 4, 2)), CInt(Mid(tmp, 1, 2)))
      k = k + 1
    Else
      If TypeName(sArr(i, 2)) = "Double" Then
        k = k + 1
        Res(k, 1) = ngay: Res(k, 4) = may
        For j = 2 To UBound(sArr, 2)
          Res(k, j + 3) = sArr(i, j)
        Next j
      Else
        may = tmp
      End If
    End If
  Next i
  With Sheets("TH")
    eRow = .Range("A" & Rows.Count).End(xlUp).Row
    If eRow > 3 Then .Range("A4:S" & eRow).Clear
    If k Then
      .Range("A4:S4").Resize(k) = Res
      .Range("A4:A4").Resize(k).NumberFormat = "dd/mm/yyyy"
      .Range("A4:S4").Resize(k).Borders.LineStyle = 1
    End If
  End With
End Sub

 

[kaka01]

Sub TongHop()
  Dim sArr(), Res()
  Dim i As Long, k As Long, j As Byte, eRow As Long
  Dim tmp, ngay, may As String
  With Sheets("Dulieu")
    eRow = .Range("C" & Rows.Count).End(xlUp).Row
    If eRow < 5 Then MsgBox ("Khong co du lieu"): Exit Sub
    sArr = .Range("A3:P" & eRow).Value
    eRow = UBound(sArr)
  End With
  ReDim Res(1 To eRow, 1 To UBound(sArr, 2) + 3)
  k = -1
  For i = 1 To eRow
    tmp = sArr(i, 1)
    If Len(tmp) = 10 And Mid(tmp, 3, 1) = "/" Then
      ngay = DateSerial(CInt(Mid(tmp, 7, 4)), CInt(Mid(tmp, 4, 2)), CInt(Mid(tmp, 1, 2)))
      k = k + 1
    Else
      If TypeName(sArr(i, 2)) = "Double" Then
        k = k + 1
        Res(k, 1) = ngay: Res(k, 4) = may
        For j = 2 To UBound(sArr, 2)
          Res(k, j + 3) = sArr(i, j)
        Next j
      Else
        may = tmp
      End If
    End If
  Next i
  With Sheets("TH")
    eRow = .Range("A" & Rows.Count).End(xlUp).Row
    If eRow > 3 Then .Range("A4:S" & eRow).Clear
    If k Then
      .Range("A4:S4").Resize(k) = Res
      .Range("A4:A4").Resize(k).NumberFormat = "dd/mm/yyyy"
      .Range("A4:S4").Resize(k).Borders.LineStyle = 1
    End If
  End With
End Sub

Cảm ơn anh HieuCD đã trợ giúp!
Code đã đáp ứng được theo đề bài
em nghiên cứu thêm có gì chưa hiểu nhờ anh trợ giúp tiếp
Chân trọng cảm ơn anh!

 

[kaka01]

Gửi anh HieuCD!
Anh cho em hỏi thêm một chút về phần code hôm qua anh trợ giúp
1, Phần Sheet TH các ngày đang cách nhau bằng một dòng trống
có thể bỏ được dòng này không anh nếu được anh sửa lại code giúp em nhé
2, Tại Sheet Dulieu có một số máy tại ngày tương ứng không có dữ liệu
(Từ cột D-> Cột P là các dòng trống) -> thì máy này bỏ qua không
tổng hợp vào sheet TH nữa nếu được anh sửa code giúp em nhé
Em gửi lại file đính kèm
Cảm ơn anh!

 

[HieuCD]

Gửi anh HieuCD!
Anh cho em hỏi thêm một chút về phần code hôm qua anh trợ giúp
1, Phần Sheet TH các ngày đang cách nhau bằng một dòng trống
có thể bỏ được dòng này không anh nếu được anh sửa lại code giúp em nhé
2, Tại Sheet Dulieu có một số máy tại ngày tương ứng không có dữ liệu
(Từ cột D-> Cột P là các dòng trống) -> thì máy này bỏ qua không
tổng hợp vào sheet TH nữa nếu được anh sửa code giúp em nhé
Em gửi lại file đính kèm
Cảm ơn anh!

Sub TongHop()
  Dim sArr(), Res()
  Dim i As Long, k As Long, n As Byte, j As Byte, eRow As Long
  Dim tmp, ngay, may As String, dl As Boolean
  With Sheets("Dulieu")
    eRow = .Range("C" & Rows.Count).End(xlUp).Row
    If eRow < 5 Then MsgBox ("Khong co du lieu"): Exit Sub
    sArr = .Range("A3:P" & eRow).Value
    eRow = UBound(sArr)
  End With
  ReDim Res(1 To eRow, 1 To UBound(sArr, 2) + 3)
  For i = 1 To eRow
    tmp = sArr(i, 1)
    If Len(tmp) = 10 And Mid(tmp, 3, 1) = "/" Then
      ngay = DateSerial(CInt(Mid(tmp, 7, 4)), CInt(Mid(tmp, 4, 2)), CInt(Mid(tmp, 1, 2)))
    Else
      If TypeName(sArr(i, 2)) = "Double" Then
        For n = 4 To UBound(sArr, 2)
          If Len(sArr(i, n)) Then
            k = k + 1
            Res(k, 1) = ngay: Res(k, 4) = may
            For j = 2 To UBound(sArr, 2)
              Res(k, j + 3) = sArr(i, j)
            Next j
            Exit For
          End If
        Next n
      Else
        may = tmp
      End If
    End If
  Next i
  With Sheets("TH")
    eRow = .Range("A" & Rows.Count).End(xlUp).Row
    If eRow > 3 Then .Range("A4:S" & eRow).Clear
    If k Then
      .Range("A4:S4").Resize(k) = Res
      .Range("A4:A4").Resize(k).NumberFormat = "dd/mm/yyyy"
      .Range("A4:S4").Resize(k).Borders.LineStyle = 1
    End If
  End With
End Sub

 

[kaka01]

Sub TongHop()
  Dim sArr(), Res()
  Dim i As Long, k As Long, n As Byte, j As Byte, eRow As Long
  Dim tmp, ngay, may As String, dl As Boolean
  With Sheets("Dulieu")
    eRow = .Range("C" & Rows.Count).End(xlUp).Row
    If eRow < 5 Then MsgBox ("Khong co du lieu"): Exit Sub
    sArr = .Range("A3:P" & eRow).Value
    eRow = UBound(sArr)
  End With
  ReDim Res(1 To eRow, 1 To UBound(sArr, 2) + 3)
  For i = 1 To eRow
    tmp = sArr(i, 1)
    If Len(tmp) = 10 And Mid(tmp, 3, 1) = "/" Then
      ngay = DateSerial(CInt(Mid(tmp, 7, 4)), CInt(Mid(tmp, 4, 2)), CInt(Mid(tmp, 1, 2)))
    Else
      If TypeName(sArr(i, 2)) = "Double" Then
        For n = 4 To UBound(sArr, 2)
          If Len(sArr(i, n)) Then
            k = k + 1
            Res(k, 1) = ngay: Res(k, 4) = may
            For j = 2 To UBound(sArr, 2)
              Res(k, j + 3) = sArr(i, j)
            Next j
            Exit For
          End If
        Next n
      Else
        may = tmp
      End If
    End If
  Next i
  With Sheets("TH")
    eRow = .Range("A" & Rows.Count).End(xlUp).Row
    If eRow > 3 Then .Range("A4:S" & eRow).Clear
    If k Then
      .Range("A4:S4").Resize(k) = Res
      .Range("A4:A4").Resize(k).NumberFormat = "dd/mm/yyyy"
      .Range("A4:S4").Resize(k).Borders.LineStyle = 1
    End If
  End With
End Sub

Cảm ơn anh đã trợ giúp!
Code rất khớp với đề bài
Anh cho em hỏi thêm một chút về câu lệnh
TypeName(..) = "Double" theo dữ liệu bài trên thì
Sheet Dulieu cột 2 là các số (1,2,3) theo em là Integer
nhưng khi chạy code theo TypeName(sArr(i, 2)) = "Double" thì vẫn là True
em thử test: TypeName(1) = Integer còn TypeName(1.0) = Double
có thể em đang hiểu sai về hàm TypeName? nhờ anh giải thích giúp
Chân thành cảm ơn anh!

 

[HieuCD]

Cảm ơn anh đã trợ giúp!
Code rất khớp với đề bài
Anh cho em hỏi thêm một chút về câu lệnh
TypeName(..) = "Double" theo dữ liệu bài trên thì
Sheet Dulieu cột 2 là các số (1,2,3) theo em là Integer
nhưng khi chạy code theo TypeName(sArr(i, 2)) = "Double" thì vẫn là True
em thử test: TypeName(1) = Integer còn TypeName(1.0) = Double
có thể em đang hiểu sai về hàm TypeName? nhờ anh giải thích giúp
Chân thành cảm ơn anh!

TypeName(sArr(i, 2)) với sArr(i, 2) là giá trị số trong bảng tính, thì nó hiểu là Double vì trong cell có thể nhập 1 hoặc 1.1 hoặc ....
TypeName(1), do nhập trực tiếp nên nó dò giá trị và biết được dạng là Integer, nếu tăng số nguyên lên 10000000 thì nó biết là Long

 

[AutoReply]

TypeName(sArr(i, 2)) với sArr(i, 2) là giá trị số trong bảng tính, thì nó hiểu là Double vì trong cell có thể nhập 1 hoặc 1.1 hoặc ....
TypeName(1), do nhập trực tiếp nên nó dò giá trị và biết được dạng là Integer, nếu tăng số nguyên lên 10000000 thì nó biết là Long

gặp cái này thì nó biết là gì anh ?
100000000000000

 

[HieuCD]

gặp cái này thì nó biết là gì anh ?
100000000000000

Bạn lại đùa với mình rồi! Không biết có số nào trong VBA có phạm vi lớn hơn Double không

 

[kaka01]

TypeName(sArr(i, 2)) với sArr(i, 2) là giá trị số trong bảng tính, thì nó hiểu là Double vì trong cell có thể nhập 1 hoặc 1.1 hoặc ....
TypeName(1), do nhập trực tiếp nên nó dò giá trị và biết được dạng là Integer, nếu tăng số nguyên lên 10000000 thì nó biết là Long

Vâng cảm ơn anh nhiều!
em đã hiểu thêm một chút về cách dùng hàm này.