Code load dữ liệu chạy được trên máy này nhưng lỗi trên máy khác ?

  • Thread starter thanhphuongvip
  • Ngày gửi
Trạng thái
Không mở trả lời sau này.
Euler

Euler

Administrator
Thành viên BQT
Em đang cài Office 2013. Anh thử nốt phương án của vbano1. Nếu không được nữa, thì chuyển qua mảng ạ.
 
T

thanhphuongvip

Guest
vbano1 nói:
Sửa:
Mã: 
Sheet4.Range("N" & fRow & ":N" & lrBH).Formula = "=NUMBERVALUE(A" & fRow & ")"
    Set rngBH = Sheet4.Range("N" & fRow & ":N" & lrBH)
chuyển thành:
Mã: 
Sheet4.Range("N" & fRow & ":N" & lrBH).Formula = "=NUMBERVALUE(A" & fRow & ")"
Thisworkbook.sheets(4).Activate
Set rngBH = Thisworkbook.sheets(4).Range("N" & fRow & ":N" & lrBH)
Nhấn để mở rộng...
Mình đã sửa theo như này, nhưng vẫn bị lỗi dòng màu vàng như cũ. ca này khó quá. Tại sao Excel 2013 trở đi ko lỗi, mà Excel 2010 trở về trước lỗi nhỉ? Mình nghĩ lỗi này xuất phát từ sự khác nhau ở các phiên bản excel, hoặc mình quên kích hoạt cái gì đó.
 
vbano1

vbano1

SMod
Thành viên BQT
vậy đưa ra cách khắc phục trước, tìm nguyên nhân sau.
Anh cho hàm này vào module bất kỳ.
Mã: 
Function Match_vba(Byval s As String, byval fRowtemp as byte,byval lrBHtem as long) As Long
Dim arr_temp    As Variant
Dim itemp       As Long

    ThisWorkbook.Sheets(4).Activate 'lam viec voi sheet 4
    arr_temp = ThisWorkbook.Sheets(4).Range("N" & fRowtemp & ":N" & lrBHtem).Value
    ThisWorkbook.Sheets(2).Activate 'Quay tro ve sheet In Hoa Don
    For itemp = LBound(arr, 1) To UBound(arr, 1) Step 1
        If Val(CStr(arr(itemp, 1))) = Val(s) Then
            Match_vba = itemp
            Exit Function
        End If
    Next itemp
End Function
Sửa:
Mã: 
vtHD = Application.Match(CLng(LstHD.Text), rngBH, 0)
thành:
Mã: 
vtHD = Match_vba(LstHD.Text,fRow,lrBH)
@thanhphuongvip vừa cập nhật lại code, anh báo lại kết quả cho tôi biết nhé.
 
S

Snow24

Guest
@vbano1 cho mình hỏi tại sao không dùng Find trong VBA nó nhanh hơn mà không dùng.:D.Lại phải viết thêm cái hàm nữa.
 
vbano1

vbano1

SMod
Thành viên BQT
Tôi hạn chế sử dụng các lệnh của Sheet, workbook để khỏi rắc rối trên các phiên bản khác nhau rồi phát sinh lỗi nếu có. Vì vậy tôi sẽ xử lý trực tiếp mà không qua các lệnh hỗ trợ nào nữa.
 
Euler

Euler

Administrator
Thành viên BQT
Mình đoán: Nếu dùng Find thì kết quả trả về là Address của Range. Mà hiện tại đang lỗi Range chưa hiểu tại sao. Đó có thể là lý do mà cách khắc phục sẽ đi trực tiếp vào tìm kiếm, lấy giá trị trả về là số, mà không dùng lệnh Find. Trong trường hợp này, bạn ấy ưu tiên giải quyết lỗi trước.
Nhìn data của tác giả thì cũng chẳng gặp vấn đề gì về tốc độ ở đây. Cửa hàng mà buôn bán lên tới vài chục nghìn dòng thì giàu to rồi, còn làm mấy cái này làm gì nữa. :D
 
T

thanhphuongvip

Guest
vbano1 nói:
vậy đưa ra cách khắc phục trước, tìm nguyên nhân sau.
Anh cho hàm này vào module bất kỳ.
Mã: 
Function Match_vba(Byval s As String, byval fRowtemp as byte,byval lrBHtem as long) As Long
Dim arr_temp    As Variant
Dim itemp       As Long

    ThisWorkbook.Sheets(4).Activate 'lam viec voi sheet 4
    arr_temp = ThisWorkbook.Sheets(4).Range("N" & fRowtemp & ":N" & lrBHtem).Value
    ThisWorkbook.Sheets(2).Activate 'Quay tro ve sheet In Hoa Don
    For itemp = LBound(arr, 1) To UBound(arr, 1) Step 1
        If Val(CStr(arr(itemp, 1))) = Val(s) Then
            Match_vba = itemp
            Exit Function
        End If
    Next itemp
End Function
Sửa:
Mã: 
vtHD = Application.Match(CLng(LstHD.Text), rngBH, 0)
thành:
Mã: 
vtHD = Match_vba(LstHD.Text,fRow,lrBH)
@thanhphuongvip vừa cập nhật lại code, anh báo lại kết quả cho tôi biết nhé.
Nhấn để mở rộng...
Sau khi sửa như @vbano1 nói thì nó báo lỗi Type miss match ở chỗ hàm
Bạn cần đăng nhập để thấy đính kèm
 
vbano1

vbano1

SMod
Thành viên BQT
Anh mở cửa sổ này lên và cho tôi xem arr được hiển thị giá trị như thế nào được không?
Nhiều khả năng lệnh gán mảng chưa được thực thi tốt, bạn cho cột N của sheet 4 hiển thị, đừng để ẩn nữa giúp tôi.
Bạn cần đăng nhập để thấy đính kèm
 
Euler

Euler

Administrator
Thành viên BQT
Anh sửa lại, bạn ấy gõ sai arr_temp thì gõ thành arr thôi.
Mã: 
Function Match_vba(Byval s As String, byval fRowtemp as byte,byval lrBHtem as long) As Long
Dim arr_temp    As Variant
Dim itemp       As Long

    ThisWorkbook.Sheets(4).Activate 'lam viec voi sheet 4
    arr_temp = ThisWorkbook.Sheets(4).Range("N" & fRowtemp & ":N" & lrBHtem).Value
    ThisWorkbook.Sheets(2).Activate 'Quay tro ve sheet In Hoa Don
    For itemp = LBound(arr_temp, 1) To UBound(arr_temp, 1) Step 1
        If Val(CStr(arr_temp(itemp, 1))) = Val(s) Then
            Match_vba = itemp
            Exit Function
        End If
    Next itemp
End Function
 
T

thanhphuongvip

Guest
Sau khi sửa đúng thì nó báo lỗi tiếp , như này:
Bạn cần đăng nhập để thấy đính kèm


Hay là mình viết lại cái khác còn nhanh hơn là đi dò từng lỗi như này anh em nhỉ?
Giải pháp tạm thời là mình cài trên máy bạn mình Excel 2013 trở lên để chạy trước.
 
vbano1

vbano1

SMod
Thành viên BQT
1. Mỗi lần báo lỗi, bạn hãy cho chuột chỉ vào các biến và thông báo, để mọi người biết nó mang giá trị nào.
2. Bạn sửa code thành Ngay =Cdate(Sheet4.Range...)
 
S

Snow24

Guest
@thanhphuongvip Bạn sử dụng code này xem được không nhé.
Mã: 
Public arr
'Public dic As New Scripting.Dictionary
Public dic As Object

Private Sub LstHD_Click()
       Dim kq, i, s As String, a As Long, dk As String, k As Long, lr As Long, b As Integer
       b = LstHD.ListIndex
       dk = LstHD.List(b, 0)
       ReDim kq(1 To UBound(arr), 1 To 9)
       If dic.Exists(dk) Then
          s = dic.Item(dk)
          For Each i In Split(s, "#")
              a = a + 1
              kq(a, 1) = a
              For k = 2 To 9
                 kq(a, k) = arr(i, k + 1)
              Next k
          Next i
       End If
       With Sheets("HoaDon")
            lr = .Range("A" & Rows.Count).End(xlUp).Row
            If lr > 11 Then .Range("a12:I" & lr).ClearContents
            If a Then .Range("A12:I12").Resize(a).Value = kq
       End With
End Sub

Private Sub TxtHD_Change()
        Dim kq, i, s As String, a As Long, dk As String, k As Long, lr As Long, b As Integer
       dk = TxtHD.Value
       ReDim kq(1 To UBound(arr), 1 To 9)
       If dic.Exists(dk) Then
          s = dic.Item(dk)
          For Each i In Split(s, "#")
              a = a + 1
              kq(a, 1) = a
              For k = 2 To 9
                 kq(a, k) = arr(i, k + 1)
              Next k
          Next i
       End If
       With Sheets("HoaDon")
            lr = .Range("A" & Rows.Count).End(xlUp).Row
            If lr > 11 Then .Range("a12:I" & lr).ClearContents
            If a Then .Range("A12:I12").Resize(a).Value = kq
       End With
End Sub

Private Sub UserForm_Initialize()
     Set dic = CreateObject("scripting.dictionary")
     Dim i As Long, kq, lr As Long, dk As String, a As Integer
     With Sheets("ChiTietBanHang")
          lr = .Range("A" & Rows.Count).End(xlUp).Row
          arr = .Range("A10:J" & lr).Value
     End With
         ReDim kq(1 To UBound(arr), 1 To 1)
         For i = 1 To UBound(arr)
             dk = arr(i, 1)
             If Not dic.Exists(dk) Then
                a = a + 1
                kq(a, 1) = dk
                dic.Add dk, i
              Else
                 dic.Item(dk) = dic.Item(dk) & "#" & i
              End If
        Next i
        LstHD.List = kq
End Sub
 
T

thanhphuongvip

Guest
Snow24 nói:
@thanhphuongvip Bạn sử dụng code này xem được không nhé.
Mã: 
Public arr
'Public dic As New Scripting.Dictionary
Public dic As Object

Private Sub LstHD_Click()
       Dim kq, i, s As String, a As Long, dk As String, k As Long, lr As Long, b As Integer
       b = LstHD.ListIndex
       dk = LstHD.List(b, 0)
       ReDim kq(1 To UBound(arr), 1 To 9)
       If dic.Exists(dk) Then
          s = dic.Item(dk)
          For Each i In Split(s, "#")
              a = a + 1
              kq(a, 1) = a
              For k = 2 To 9
                 kq(a, k) = arr(i, k + 1)
              Next k
          Next i
       End If
       With Sheets("HoaDon")
            lr = .Range("A" & Rows.Count).End(xlUp).Row
            If lr > 11 Then .Range("a12:I" & lr).ClearContents
            If a Then .Range("A12:I12").Resize(a).Value = kq
       End With
End Sub

Private Sub TxtHD_Change()
        Dim kq, i, s As String, a As Long, dk As String, k As Long, lr As Long, b As Integer
       dk = TxtHD.Value
       ReDim kq(1 To UBound(arr), 1 To 9)
       If dic.Exists(dk) Then
          s = dic.Item(dk)
          For Each i In Split(s, "#")
              a = a + 1
              kq(a, 1) = a
              For k = 2 To 9
                 kq(a, k) = arr(i, k + 1)
              Next k
          Next i
       End If
       With Sheets("HoaDon")
            lr = .Range("A" & Rows.Count).End(xlUp).Row
            If lr > 11 Then .Range("a12:I" & lr).ClearContents
            If a Then .Range("A12:I12").Resize(a).Value = kq
       End With
End Sub

Private Sub UserForm_Initialize()
     Set dic = CreateObject("scripting.dictionary")
     Dim i As Long, kq, lr As Long, dk As String, a As Integer
     With Sheets("ChiTietBanHang")
          lr = .Range("A" & Rows.Count).End(xlUp).Row
          arr = .Range("A10:J" & lr).Value
     End With
         ReDim kq(1 To UBound(arr), 1 To 1)
         For i = 1 To UBound(arr)
             dk = arr(i, 1)
             If Not dic.Exists(dk) Then
                a = a + 1
                kq(a, 1) = dk
                dic.Add dk, i
              Else
                 dic.Item(dk) = dic.Item(dk) & "#" & i
              End If
        Next i
        LstHD.List = kq
End Sub
Nhấn để mở rộng...
Code này chạy quá chuẩn và quá nhanh luôn.
Ah thiếu mất 2 thông tin cần lấy, @Snow24 bổ sung dùm mình thông tin Mã Khách Hàng và Diễn giả nữa nhé! Cảm ơn nhất nhiều!

Bạn cần đăng nhập để thấy hình ảnh


Bạn cần đăng nhập để thấy hình ảnh
 
tuhocvba

tuhocvba

Administrator
Thành viên BQT
Đề nghị đọc code thì phải hiểu và thử tự sửa đê. Coi như bài tập luyện tập.
@Snow24 thử không hỗ trợ nữa xem @thanhphuongvip có tự sửa được không nhé. Không lẽ đọc code không hiểu gì thì còn ý nghĩa gì nữa :D
 
T

thanhphuongvip

Guest
tuhocvba nói:
Đề nghị đọc code thì phải hiểu và thử tự sửa đê. Coi như bài tập luyện tập.
@Snow24 thử không hỗ trợ nữa xem @thanhphuongvip có tự sửa được không nhé. Không lẽ đọc code không hiểu gì thì còn ý nghĩa gì nữa :D
Nhấn để mở rộng...
Nếu như mình tự mò thì mình sẽ dùng hàm Vlookup để tra, chỉ biết tới đó thôi. Nếu @Snow24 viết cho mình để lấy 1 thông tin phần đầu thì những cái sau mình cũng biết lấy luôn, mà hình như Snow quên lấy cái thông tin phần đầu hóa đơn nên mình ko biết thêm nó vô chỗ nào, hihi

Bạn cần đăng nhập để thấy hình ảnh
 
Euler

Euler

Administrator
Thành viên BQT
Cái khổ nhất là người code không comment cũng không diễn giải nên người đọc vô phương sửa chữa. Ngay cả người giỏi code, thì đọc code người khác cũng khó.
UserForm_Initialize: Nạp dữ liệu từ excel, cho vào từ điển.
Private Sub TxtHD_Change() : Ở đây cần khai báo lại mảng arr, hiện tại chỉ lấy từ cột A tới cột I (9 cột).
Sửa thành 13 cột:
Mã: 
ReDim kq(1 To UBound(arr), 1 To 13)
Tương tự:
Private Sub LstHD_Click(): Cũng phải sửa lại khai báo mảng thành 13 như trên.

Toàn bộ lệnh for next sửa thành:
For k = 2 To 13
Tới đây thì anh dùng F5 chặn lệnh xem tiếp. File anh đặt pass, máy em không cài công cụ phá, nên nhìn hình đoán chữ như trên. Ủng hộ anh tự lực sửa theo đúng phương châm Tự Học. Mong @Snow24 từ sau code thì nên comment hoặc giải thích thêm vào bài viết. Code cứ đưa như thế này có khác nào đánh đố, chỉ copy và sử dụng :D
 
giaiphapvba

giaiphapvba

Administrator
Thành viên BQT
Im ắng thế này chắc đang luyện tập rồi.
Em hoàn thiện nốt hai cái ô còn sót nhé.
Mã: 
Public arr
'Public dic As New Scripting.Dictionary
Public dic As Object

Private Sub LstHD_Click()
       Dim kq, i, s As String, a As Long, dk As String, k As Long, lr As Long, b As Integer
       Dim diengiai As String
       Dim makhachhang As String
       Dim khachhang      As String  'giaiphapvba
       Dim ngayxuat As String 'giaiphapvba
       
       
       b = LstHD.ListIndex
       dk = LstHD.List(b, 0)
       ReDim kq(1 To UBound(arr), 1 To 13)
       If dic.Exists(dk) Then
          s = dic.Item(dk)
          For Each i In Split(s, "#")
              a = a + 1
              kq(a, 1) = a
              For k = 2 To 12
                 kq(a, k) = arr(i, k + 1)
              Next k
              diengiai = CStr(arr(i, 13))
              makhachhang = CStr(arr(i, 12))
              khachhang = CStr(arr(i, 11))
              ngayxuat = CStr(arr(i, 2))
          Next i
       End If
       With Sheets("HoaDon")
            lr = .Range("A" & Rows.Count).End(xlUp).Row
            If lr > 11 Then .Range("a12:I" & lr).ClearContents
            If a Then .Range("A12:I12").Resize(a).Value = kq
       End With
       Sheets("HoaDon").Cells(6, 3).Value = diengiai
       
       Sheets("HoaDon").Cells(5, 8).Value = makhachhang
       
       Sheets("HoaDon").Cells(5, 3).Value = khachhang
       Sheets("HoaDon").Cells(6, 8).Value = ngayxuat
End Sub

Private Sub TxtHD_Change()
        Dim kq, i, s As String, a As Long, dk As String, k As Long, lr As Long, b As Integer
        Dim diengiai As String
       Dim makhachhang As String
       Dim khachhang      As String 'giaiphapvba
       Dim ngayxuat As String 'giaiphapvba
       
       dk = TxtHD.Value
       ReDim kq(1 To UBound(arr), 1 To 13)
       If dic.Exists(dk) Then
          s = dic.Item(dk)
          For Each i In Split(s, "#")
              a = a + 1
              kq(a, 1) = a
              For k = 2 To 12
                 kq(a, k) = arr(i, k + 1)
              Next k
              tenkhachhang = CStr(arr(i, 11))
              makhachhang = CStr(arr(i, 12))
              khachhang = CStr(arr(i, 11))
              ngayxuat = CStr(arr(i, 2))
          Next i
       End If
       With Sheets("HoaDon")
            lr = .Range("A" & Rows.Count).End(xlUp).Row
            If lr > 11 Then .Range("a12:I" & lr).ClearContents
            If a Then .Range("A12:I12").Resize(a).Value = kq
            
       End With
       Sheets("HoaDon").Cells(6, 3).Value = diengiai
       
       Sheets("HoaDon").Cells(5, 8).Value = makhachhang
       Sheets("HoaDon").Cells(5, 3).Value = khachhang
       Sheets("HoaDon").Cells(6, 8).Value = ngayxuat
End Sub

Private Sub UserForm_Initialize()
     Set dic = CreateObject("scripting.dictionary")
     Dim i As Long, kq, lr As Long, dk As String, a As Integer
     With Sheets("ChiTietBanHang")
          lr = .Range("A" & Rows.Count).End(xlUp).Row
          arr = .Range("A10:M" & lr).Value
     End With
         ReDim kq(1 To UBound(arr), 1 To 1)
         For i = 1 To UBound(arr)
             dk = arr(i, 1)
             If Not dic.Exists(dk) Then
                a = a + 1
                kq(a, 1) = dk
                dic.Add dk, i
              Else
                 dic.Item(dk) = dic.Item(dk) & "#" & i
              End If
        Next i
        LstHD.List = kq
End Sub
 
T

thanhphuongvip

Guest
Hoàn tất rồi, cảm ơn các bạn đã giải đáp, nhưng xin Mod đừng đóng topic nha, mình đang tìm hiểu code, có chỗ nào chưa hiểu mình sẽ hỏi, mong các bạn giải đáp để mình hiểu hơn, hihi
 
Trạng thái
Không mở trả lời sau này.
Top