Dùng vba lấy dữ liệu trên file tải về từ phần mềm

[LightStar252]

Giúp mình thống kê số ngày của mỗi máy tại từng địa điểm trong tháng (lấy số liệu từ "sheet" qua "sheet 1". Thanks ạ!

 

[LightStar252]

Giúp mình thống kê số ngày của mỗi máy tại từng địa điểm trong tháng (lấy số liệu từ "sheet" qua "sheet 1". Cảm ơn ạ!

Hoặc dùng hàm cũng được nha mọi ng

 

[Ba Tê]

Giúp mình thống kê số ngày của mỗi máy tại từng địa điểm trong tháng (lấy số liệu từ "sheet" qua "sheet 1". Cảm ơn ạ!

Đặt tên sheet gì kỳ quá.
Đổi tên "Sheet" thành "Data", "Sheet1" thành "Gpe".

Public Sub sGpe()
Dim Dic As Object, sArr(), dArr(), I As Long, J As Long, K As Long, R As Long, Rws As Long, Xe As String, Txt As String
Set Dic = CreateObject("Scripting.Dictionary")
    sArr = Sheets("Data").Range("B4", Sheets("Data").Range("D60000").End(xlUp)).Resize(, 15).Value
    R = UBound(sArr)
ReDim dArr(1 To R, 1 To 4)
For I = 1 To R
    If sArr(I, 1) <> Empty Then
        Xe = sArr(I, 1)
        K = K + 1
        dArr(K, 1) = K
        dArr(K, 2) = Xe
        K = K - 1
    End If
    If sArr(I, 15) <> Empty Then
        Txt = Xe & "#" & sArr(I, 15)
        If Not Dic.Exists(Txt) Then
            K = K + 1
            Dic.Item(Txt) = K
            dArr(K, 3) = sArr(I, 15)
            dArr(K, 4) = 1
        Else
            Rws = Dic.Item(Txt)
            dArr(Rws, 4) = dArr(Rws, 4) + 1
        End If
    End If
Next I
With Sheets("Gpe")
    .Range("A7").Resize(10000, 4).ClearContents
    .Range("A7").Resize(K, 4) = dArr
    .Range("A7").Resize(K, 4).Borders.LineStyle = 1
End With
End Sub

 

[LightStar252]

Đặt tên sheet gì kỳ quá.
Đổi tên "Sheet" thành "Data", "Sheet1" thành "Gpe".

Public Sub sGpe()
Dim Dic As Object, sArr(), dArr(), I As Long, J As Long, K As Long, R As Long, Rws As Long, Xe As String, Txt As String
Set Dic = CreateObject("Scripting.Dictionary")
    sArr = Sheets("Data").Range("B4", Sheets("Data").Range("D60000").End(xlUp)).Resize(, 15).Value
    R = UBound(sArr)
ReDim dArr(1 To R, 1 To 4)
For I = 1 To R
    If sArr(I, 1) <> Empty Then
        Xe = sArr(I, 1)
        K = K + 1
        dArr(K, 1) = K
        dArr(K, 2) = Xe
        K = K - 1
    End If
    If sArr(I, 15) <> Empty Then
        Txt = Xe & "#" & sArr(I, 15)
        If Not Dic.Exists(Txt) Then
            K = K + 1
            Dic.Item(Txt) = K
            dArr(K, 3) = sArr(I, 15)
            dArr(K, 4) = 1
        Else
            Rws = Dic.Item(Txt)
            dArr(Rws, 4) = dArr(Rws, 4) + 1
        End If
    End If
Next I
With Sheets("Gpe")
    .Range("A7").Resize(10000, 4).ClearContents
    .Range("A7").Resize(K, 4) = dArr
    .Range("A7").Resize(K, 4).Borders.LineStyle = 1
End With
End Sub

Quá tuyệt. Cảm ơn ạ! )))