giúp đoạn code Tỉm kiếm và tổng hợp (1 người xem)

[kan]

Mình có bảng dữ liệu khá nhiều, nhờ các thành viên viết cho đoạn code để tổng hợp cho nhanh.
- Tìm ở cột K9 hoặc K10 nếu giá trị <>0 thì copy sang sheet("TH") vào các cột tương ứng K9, K10 và K11;
- Tính giá trị bình quân theo ngày ở cột Z sau đó copy sang sheet("TH") vào cột Z tương ứng.
Nội dung nhờ giúp đỡ mình ghi trong file đính kèm.
Xin cám ơn nhiều.

 

[Quang_Hải]

Mình có bảng dữ liệu khá nhiều, nhờ các thành viên viết cho đoạn code để tổng hợp cho nhanh. Nội dung nhờ giúp đỡ mình ghi trong file đính kèm.
Xin cám ơn nhiều.

1. Có thể bạn đã gởi nhầm file
2. Có thể bạn gõ nhầm yêu cầu trong file
3. Có thể mắt của mình có vấn đề nên đọc hoài không thấy dữ liệu tương ứng với yêu cầu

 

[ndu96081631]

Mình có bảng dữ liệu khá nhiều, nhờ các thành viên viết cho đoạn code để tổng hợp cho nhanh. Nội dung nhờ giúp đỡ mình ghi trong file đính kèm.
Xin cám ơn nhiều.

Dữ liệu trong sheet DL của bạn chỉ đến cột K, vậy mà bạn lại yêu cầu:

Nhờ các thành viên viết đoạn code để tổng hợp:
- Nếu giá trị ở cột N hoặc cột O khác 0 thì copy giá trị ở các ô trong cột M, N và O sang sheet("TH")
- Cột Z thì tính giá trị bình quân theo ngày, sau đó copy giá trị bình quân đó sang sheet("TH")

Mấy cột mà bạn nói phải "tưởng tượng" ra à?

 

[kan]

Vâng, xin lỗi mọi người ! do mình đã xóa bớt mấy cột không cần thiết trong bảng tính nên dữ liệu bị dồn.
Vẫn là file đã gửi, chỉ là thay tên các cột mà thôi. Mình gửi lại, hy vọng Quanghai1969 và ndu9608 giúp đỡ.
Cám ơn nhiều !

 

[Quang_Hải]

Vâng, xin lỗi mọi người ! do mình đã xóa bớt mấy cột không cần thiết trong bảng tính nên dữ liệu bị dồn.
Vẫn là file đã gửi, chỉ là thay tên các cột mà thôi. Mình gửi lại, hy vọng Quanghai1969 và ndu9608 giúp đỡ.
Cám ơn nhiều !

Nếu vẫn là cái file trên kia chưa được update thì mình xin chào thua

 

[kan]

Mình đã update rồi mà

 

[kan]

Mình đã cập nhật file dữ liệu, nhờ các thành viên giúp đỡ nhé.
Cám ơn nhiều !

 

[Quang_Hải]

Mình có bảng dữ liệu khá nhiều, nhờ các thành viên viết cho đoạn code để tổng hợp cho nhanh.
- Tìm ở cột K9 hoặc K10 nếu giá trị <>0 thì copy sang sheet("TH") vào các cột tương ứng K9, K10 và K11;
- Tính giá trị bình quân theo ngày ở cột Z sau đó copy sang sheet("TH") vào cột Z tương ứng.
Nội dung nhờ giúp đỡ mình ghi trong file đính kèm.
Xin cám ơn nhiều.

Code của bạn đây. Cũng chưa biết đúng hay không, nhưng cứ thử đi, chỗ nào chưa trúng thì tính tiếp

Sub laydulieu()
Dim ketqua, dulieu, i, j
Sheets("TH").[b5:aw35].ClearContents
ketqua = Sheets("TH").[b5:aw35].Value
With Sheets("DL")
  dulieu = .Range(.[a4], .[k65536].End(3)).Value
End With
For j = 1 To UBound(dulieu)
  i = Day(dulieu(j, 1))
  If dulieu(j, 2) = "" Then
    If Month(dulieu(j, 1)) = 1 Then
      ketqua(i, 1) = dulieu(j, 4)
        ketqua(i, 2) = dulieu(j, 9)
          ketqua(i, 3) = dulieu(j, 10)
            ketqua(i, 4) = dulieu(j, 11)
    ElseIf Month(dulieu(j, 1)) = 2 Then
      ketqua(i, 5) = dulieu(j, 4)
        ketqua(i, 6) = dulieu(j, 9)
          ketqua(i, 7) = dulieu(j, 10)
            ketqua(i, 8) = dulieu(j, 11)
    ElseIf Month(dulieu(j, 1)) = 3 Then
      ketqua(i, 9) = dulieu(j, 4)
        ketqua(i, 10) = dulieu(j, 9)
          ketqua(i, 11) = dulieu(j, 10)
            ketqua(i, 12) = dulieu(j, 11)
    ElseIf Month(dulieu(j, 1)) = 4 Then
      ketqua(i, 13) = dulieu(j, 4)
        ketqua(i, 14) = dulieu(j, 9)
          ketqua(i, 15) = dulieu(j, 10)
            ketqua(i, 16) = dulieu(j, 11)
    ElseIf Month(dulieu(j, 1)) = 5 Then
      ketqua(i, 17) = dulieu(j, 4)
        ketqua(i, 18) = dulieu(j, 9)
          ketqua(i, 19) = dulieu(j, 10)
            ketqua(i, 20) = dulieu(j, 11)
    ElseIf Month(dulieu(j, 1)) = 6 Then
      ketqua(i, 21) = dulieu(j, 4)
        ketqua(i, 22) = dulieu(j, 9)
          ketqua(i, 23) = dulieu(j, 10)
            ketqua(i, 24) = dulieu(j, 11)
    ElseIf Month(dulieu(j, 1)) = 7 Then
      ketqua(i, 25) = dulieu(j, 4)
        ketqua(i, 26) = dulieu(j, 9)
          ketqua(i, 27) = dulieu(j, 10)
            ketqua(i, 28) = dulieu(j, 11)
    ElseIf Month(dulieu(j, 1)) = 8 Then
      ketqua(i, 29) = dulieu(j, 4)
        ketqua(i, 30) = dulieu(j, 9)
          ketqua(i, 31) = dulieu(j, 10)
            ketqua(i, 32) = dulieu(j, 11)
    ElseIf Month(dulieu(j, 1)) = 9 Then
      ketqua(i, 33) = dulieu(j, 4)
        ketqua(i, 34) = dulieu(j, 9)
          ketqua(i, 35) = dulieu(j, 10)
            ketqua(i, 36) = dulieu(j, 11)
    ElseIf Month(dulieu(j, 1)) = 10 Then
      ketqua(i, 37) = dulieu(j, 4)
        ketqua(i, 38) = dulieu(j, 9)
          ketqua(i, 39) = dulieu(j, 10)
            ketqua(i, 40) = dulieu(j, 11)
    ElseIf Month(dulieu(j, 1)) = 11 Then
      ketqua(i, 41) = dulieu(j, 4)
        ketqua(i, 42) = dulieu(j, 9)
          ketqua(i, 43) = dulieu(j, 10)
            ketqua(i, 44) = dulieu(j, 11)
    ElseIf Month(dulieu(j, 1)) = 12 Then
      ketqua(i, 45) = dulieu(j, 4)
        ketqua(i, 46) = dulieu(j, 9)
          ketqua(i, 47) = dulieu(j, 10)
            ketqua(i, 48) = dulieu(j, 11)
    End If
  End If
Next
Sheets("TH").[b5].Resize(31, 48) = ketqua
End Sub

 

[hoangvuluan]

@quanghai: test lại xem thử, dãy if-elseif có thể thay bằng công thức này không:
k = (Month(dulieu(j, 1)) - 1) * 4
ketqua(i, k + 1) = dulieu(j, 4)
ketqua(i, k + 2) = dulieu(j, 9)
ketqua(i, k + 3) = dulieu(j, 10)
ketqua(i, k + 4) = dulieu(j, 11)

 

[Quang_Hải]

@quanghai: test lại xem thử, dãy if-elseif có thể thay bằng công thức này không:
k = (Month(dulieu(j, 1)) - 1) * 4
ketqua(i, k + 1) = dulieu(j, 4)
ketqua(i, k + 2) = dulieu(j, 9)
ketqua(i, k + 3) = dulieu(j, 10)
ketqua(i, k + 4) = dulieu(j, 11)

Cách của anh chính xác, thay được hết các đoạn code lòng vòng bằng biến K. Hay quá.

To Kan:

Ghép code lại cho bạn đây

Sub laydulieu()
Dim ketqua, dulieu, i, j,k
Sheets("TH").[B5:AW35].ClearContents
ketqua = Sheets("TH").[B5:AW35].Value
With Sheets("DL")
  dulieu = .Range(.[a4], .[k65536].End(3)).Value
End With
For j = 1 To UBound(dulieu)
  i = Day(dulieu(j, 1))
    If dulieu(j, 2) = "" Then
      k = (Month(dulieu(j, 1)) - 1) * 4
        ketqua(i, k + 1) = dulieu(j, 4)
          ketqua(i, k + 2) = dulieu(j, 9)
            ketqua(i, k + 3) = dulieu(j, 10)
              ketqua(i, k + 4) = dulieu(j, 11)
    End If
Next
Sheets("TH").[b5].Resize(31, 48) = ketqua
End Sub

 

[kan]

Cám ơn Quanghai và Vuluan, tuy nhiên giá trị của cột Z bên sheet("TH") mình cần là giá trị bình quân ngày (bình quân theo giá trị giờ trong ngày bên sheet("DL").
Ví dụ cụ thể, giá trị Z ở ô B5 bên sheet("TH") sẽ bằng bình quân giá trị Z từ ô D4 - D27 bên sheet("DL") (= AVERAGE (DL!D427) =484.844).
Tương tự, giá trị Z ở ô B6 bên sheet("TH") sẽ bằng bình quân giá trị Z từ ô D28 - D51....

Nhờ Quanghai, Vuluan và các thành viên hoàn thiện tiếp giúp mình nhé ! Cám ơn.

 

[Quang_Hải]

Cuối cùng cũng cố đoán ý của tác giả, may ra thì đúng trật ráng chịu

Sub laydulieu()
Dim ketqua, dulieu
Dim jj As Long, i As Long, j As Long, k As Long, binhquan As Double
Sheets("TH").[B5:AW35].ClearContents
ketqua = Sheets("TH").[B5:AW35].Value
With Sheets("DL")
  dulieu = .Range(.[a4], .[k65536].End(3)).Value
End With
For j = 1 To UBound(dulieu)
  i = Day(dulieu(j, 1))
    If dulieu(j, 2) = "" Then
      k = (Month(dulieu(j, 1)) - 1) * 4
      For jj = 0 To 23
        binhquan = binhquan + dulieu(j + jj, 4)
      Next
        ketqua(i, k + 1) = binhquan / 24
          ketqua(i, k + 2) = dulieu(j, 9)
        ketqua(i, k + 3) = dulieu(j, 10)
      ketqua(i, k + 4) = dulieu(j, 11)
    End If
binhquan = 0
Next
Sheets("TH").[b5].Resize(31, 48) = ketqua
End Sub

 

[kan]

có lẽ do mình mô tả rối quá, mình mô tả cụ thể hơn rồi, hy vọng các thành viên hiểu ý đồ của mình. (Mô tả ở bên trên)

 

[kan]

Cám ơn Quanghai đã hồi âm.
- Chạy đoạn code này thì thông báo lôi "Subsript out of range" ở dòng binhquan = binhquan + dulieu(j + jj, 4);
- Chạy đoạn code trước đây thì ở ngày 5 của tháng 7 bên sheet("TH") vẫn có giá trị là "BK"
Nhờ Quanghai gỡ hộ mình. Cám ơn nhiều.

Cuối cùng cũng cố đoán ý của tác giả, may ra thì đúng trật ráng chịu

Sub laydulieu()
Dim ketqua, dulieu
Dim jj As Long, i As Long, j As Long, k As Long, binhquan As Double
Sheets("TH").[B5:AW35].ClearContents
ketqua = Sheets("TH").[B5:AW35].Value
With Sheets("DL")
  dulieu = .Range(.[a4], .[k65536].End(3)).Value
End With
For j = 1 To UBound(dulieu)
  i = Day(dulieu(j, 1))
    If dulieu(j, 2) = "" Then
      k = (Month(dulieu(j, 1)) - 1) * 4
      For jj = 0 To 23
        binhquan = binhquan + dulieu(j + jj, 4)
      Next
        ketqua(i, k + 1) = binhquan / 24
          ketqua(i, k + 2) = dulieu(j, 9)
        ketqua(i, k + 3) = dulieu(j, 10)
      ketqua(i, k + 4) = dulieu(j, 11)
    End If
binhquan = 0
Next
Sheets("TH").[b5].Resize(31, 48) = ketqua
End Sub

 

[Quang_Hải]

Cám ơn Quanghai đã hồi âm.
- Chạy đoạn code này thì thông báo lôi "Subsript out of range" ở dòng binhquan = binhquan + dulieu(j + jj, 4);
- Chạy đoạn code trước đây thì ở ngày 5 của tháng 7 bên sheet("TH") vẫn có giá trị là "BK"
Nhờ Quanghai gỡ hộ mình. Cám ơn nhiều.

Lỗi xảy ra là do bạn, dữ liệu của bạn không chuẩn. Lẽ ra phải có đủ 24 giờ nhưng ngày cuối của bạn thì đang dở dang

Để khắc phục điều này bạn thêm dòng code này vào
Sub laydulieu()
On Error Resume Next
Dim ketqua, dulieu

 

[kan]

- giá trị Z đã đúng theo ý đồ của mình.
- Tuy nhiên, bên sheet("TH"), ở cột K9, K10 VÀ K11 ở tháng 7 vẫn có giá trị là "BK" ở ô AA9, AB9 và AC9 (Theo yêu cầu thì ở các ô này phải là các giá trị khác 0)

 

[Quang_Hải]

- giá trị Z đã đúng theo ý đồ của mình.
- Tuy nhiên, bên sheet("TH"), ở cột K9, K10 VÀ K11 ở tháng 7 vẫn có giá trị là "BK" ở ô AA9, AB9 và AC9 (Theo yêu cầu thì ở các ô này phải là các giá trị khác 0)

Bạn tự kiểm tra lại dữ liệu gốc của bạn đi, xem coi tai sao tất cả đều đúng duy nhât 1 chỗ không đúng!

Nếu dữ liệu đã chuẩn rồi và BK của ngày 5/7 là đúng khi xuất dũ liệu ra thì phải viết lại code, nhưng mình không hiểu tại sao dữ liệu lại có thể không đông nhất chứ!

 

[Ba Tê]

- giá trị Z đã đúng theo ý đồ của mình.
- Tuy nhiên, bên sheet("TH"), ở cột K9, K10 VÀ K11 ở tháng 7 vẫn có giá trị là "BK" ở ô AA9, AB9 và AC9 (Theo yêu cầu thì ở các ô này phải là các giá trị khác 0)

Mình tham gia 1 code viết theo kiểu hiểu của mình.
Trong sheet DL từ dòng 4860 trở xuống có các ô chứa dữ liệu là #N/A có thể làm cho kết quả bị sai, bạn tự chỉnh lại để loại bỏ nó đi.

Public Sub GPE()
Dim Rng(), Arr(), I As Long, K As Long, Tem As Double, Ngay As Long, N As Long
    Rng = Sheets("DL").Range(Sheets("DL").[A4], Sheets("DL").[A65000].End(xlUp).Offset(1)).Resize(, 11).Value
ReDim Arr(1 To UBound(Rng, 1), 1 To 50)
    For I = 1 To UBound(Rng, 1) - 1
            N = Month(Rng(I, 1)) * 4 - 3
            Ngay = Day(Rng(I, 1))
            K = K + 1: Tem = Tem + Rng(I, 4): Arr(Ngay, N) = Tem / K
        If IsNumeric(Rng(I + 1, 9)) And IsNumeric(Rng(I + 1, 10)) Then
            If Rng(I + 1, 9) > 0 Or Rng(I + 1, 10) > 0 Then
                Arr(Ngay, N + 1) = Rng(I + 1, 9): Arr(Ngay, N + 2) = Rng(I + 1, 10): Arr(Ngay, N + 3) = Rng(I + 1, 11)
            End If
            Tem = 0: K = 0
        End If
    Next I
        Sheets("TH").[B5].Resize(31, 50).Value = Arr
End Sub

 

[kan]

Đúng mong muốn của mình.
Cám ơn Quanghai và Ba tê nhiều !

Mình tham gia 1 code viết theo kiểu hiểu của mình.
Trong sheet DL từ dòng 4860 trở xuống có các ô chứa dữ liệu là #N/A có thể làm cho kết quả bị sai, bạn tự chỉnh lại để loại bỏ nó đi.

Public Sub GPE()
Dim Rng(), Arr(), I As Long, K As Long, Tem As Double, Ngay As Long, N As Long
    Rng = Sheets("DL").Range(Sheets("DL").[A4], Sheets("DL").[A65000].End(xlUp).Offset(1)).Resize(, 11).Value
ReDim Arr(1 To UBound(Rng, 1), 1 To 50)
    For I = 1 To UBound(Rng, 1) - 1
            N = Month(Rng(I, 1)) * 4 - 3
            Ngay = Day(Rng(I, 1))
            K = K + 1: Tem = Tem + Rng(I, 4): Arr(Ngay, N) = Tem / K
        If IsNumeric(Rng(I + 1, 9)) And IsNumeric(Rng(I + 1, 10)) Then
            If Rng(I + 1, 9) > 0 Or Rng(I + 1, 10) > 0 Then
                Arr(Ngay, N + 1) = Rng(I + 1, 9): Arr(Ngay, N + 2) = Rng(I + 1, 10): Arr(Ngay, N + 3) = Rng(I + 1, 11)
            End If
            Tem = 0: K = 0
        End If
    Next I
        Sheets("TH").[B5].Resize(31, 50).Value = Arr
End Sub