Cần giúp e sửa đoạn code VBA! thông tin máy (1 người xem)

  • Thread starter Thread starter vova2209
  • Ngày gửi Ngày gửi
Liên hệ QC

Người dùng đang xem chủ đề này

vova2209

Thành viên tích cực
Tham gia
5/4/17
Bài viết
835
Được thích
112
Giới tính
Nam
Nghề nghiệp
Đường bộ
Em có đoạn code này! DKList ' Neu ma so nay sai voi may thi >> end sub như này phải thêm code như nào ạ
Mã:
 Option ExplicitFunction Readserienumber()
  Application.Volatile
  With CreateObject("Scripting.FileSystemObject")
    With .GetDrive(Environ("SystemDrive"))
      If .IsReady Then
        Readserienumber = Abs(.SerialNumber)
      Else
        Readserienumber = -1
      End If
    End With
  End With
End Function


Public Sub DKList()
'---------------------------------------------------------------- code ma may
    Dim madk As String
            madk = Readserienumber()
            If madk = "1663075946" Then
            Application.StatusBar = "ok"
            Else
        Application.Calculation = xlCalculationManual
            MsgBox "Cam trom tai lieu"
        Exit Sub
    End If
End Sub


Public Sub xxx()


[COLOR=#ff0000]DKList ' Neu ma so nay sai voi may thi >> end sub[/COLOR]


    Dim sArr(), dArr(1 To 1986, 1 To 2), i As Long, j As Long, R As Long, Num As Long, k As Long
  
    sArr = Range("C2:AG77").Value: R = UBound(sArr)
    For i = 1 To R Step 2
        If sArr(i, 1) <> Empty Then
            Num = Day(DateSerial(Year(sArr(i, 1)), Month(sArr(i, 1)) + 1, 0))
                For j = 1 To Num
                    k = k + 1: dArr(k, 1) = sArr(i, j): dArr(k, 2) = sArr(i + 1, j)
                Next j
        End If
    Next i
    Range("AK2").Resize(k, 2) = dArr
    
[COLOR=#ff0000]End Sub '<<< Neu ma so nay sai voi may thi >> end sub[/COLOR]
 
Web KT

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

Back
Top Bottom