Chuyên mục xử lý, gỡ rối code VBA

[ndu96081631]

Topic Những câu hỏi về code, xin giải thích các code... đã quá dài nên mình đóng nó lại và mở topic khác
Tất cả những bài viết liên quan đến việc nhờ giải thích, xử lý và gỡ rối code VBA, các bạn vui lòng đăng tại đây!
Cảm ơn

 

[tq_thuyet]

Các bác giúp em xem vì sao nó bị lỗi nhé.
Em đang tìm hiểu code trích xuất dữ liệu từ file khác.

Option Explicit
Sub Test()
Dim sFile As String, sSheet As String, sAddr As String
sFile = ThisWorkbook.Path & "\F-1.xls"
sSheet = "リスト"
sAddr = "D5:E10"
Range("D5:E10") = GetData(sFile, sSheet, sAddr)
End Sub
Function GetData(sFile As String, sSheet As String, sAddr As String)
Dim pLink As String, iR As Long, iC As Long, Arr
If Len(Dir(sFile)) Then
Arr = Range(sAddr)
pLink = "'" & Replace(sFile, Dir(sFile), "[" & Dir(sFile) & "]") & sSheet & "'!"
For iR = 1 To Range(sAddr).Rows.Count
For iC = 1 To Range(sAddr).Columns.Count
Arr(iR, iC) = ExecuteExcel4Macro(pLink & Range(sAddr).Cells(iR, iC).Address(, , 2))
Next iC
Next iR
GetData = Arr
End If
End Function

 

[Ba Tê]

Cho mình hỏi vấn đề này nữa ạ
Mình có 2 sheet như sau:
1. Sheet "CSDL" tức là sheet cần phải cập nhật thông tin
2. Sheet "Thongtin" tức là sheet thông tin để cập nhập vào sheet "CSDL"
2 sheet CSDL và Thongtin có các cột tương ứng như nhau.
Giờ mình muốn thế này. Nếu thông tin ở Cột A và Cột B của Sheet "CSDL" và sheet "Thongtin" giống nhau thì các thông tin từ cột M đến cột AF
của sheet "Thongtin" nó sẽ copy nhặt sang sheet "CSDL"
Cảm ơn các bác.

Thử chạy code này:

Public Sub Update_CSDL()
Dim sArr(), tArr(), I As Long, J As Long, Rws As Long, R As Long, Txt As String
tArr = Sheets("Thongtin").Range("A2", Sheets("Thongtin").Range("A2").End(xlDown)).Resize(, 45).Value
With CreateObject("Scripting.Dictionary")
    For I = 1 To UBound(tArr)
        .Item(tArr(I, 1) & "#" & tArr(I, 2)) = I
    Next I
    sArr = Sheets("CSDL").Range("A2", Sheets("CSDL").Range("A2").End(xlDown)).Resize(, 45).Value
    R = UBound(sArr)
    For I = 1 To R
        Txt = sArr(I, 1) & "#" & sArr(I, 2)
        If .Exists(Txt) Then
            Rws = .Item(Txt)
            For J = 13 To 32
                sArr(I, J) = tArr(Rws, J)
            Next J
        End If
    Next I
End With
Sheets("CSDL").Range("A2").Resize(R, 45) = sArr
End Sub

 

[phulien1902]

Các bác giúp em xem vì sao nó bị lỗi nhé.
Em đang tìm hiểu code trích xuất dữ liệu từ file khác.

Option Explicit
Sub Test()
Dim sFile As String, sSheet As String, sAddr As String
sFile = ThisWorkbook.Path & "\F-1.xls"
sSheet = "リスト"
sAddr = "D5:E10"
Range("D5:E10") = GetData(sFile, sSheet, sAddr)
End Sub
Function GetData(sFile As String, sSheet As String, sAddr As String)
Dim pLink As String, iR As Long, iC As Long, Arr
If Len(Dir(sFile)) Then
Arr = Range(sAddr)
pLink = "'" & Replace(sFile, Dir(sFile), "[" & Dir(sFile) & "]") & sSheet & "'!"
For iR = 1 To Range(sAddr).Rows.Count
For iC = 1 To Range(sAddr).Columns.Count
Arr(iR, iC) = ExecuteExcel4Macro(pLink & Range(sAddr).Cells(iR, iC).Address(, , 2))
Next iC
Next iR
GetData = Arr
End If
End Function

Bạn thay tên Sheet trong khung màu đỏ bằng 1 cái tên cụ thể xem

 

[tq_thuyet]

Bạn thay tên Sheet trong khung màu đỏ bằng 1 cái tên cụ thể xem
View attachment 197007

Cảm ơn bạn.
Vẫn không được bạn ơi.

Bài đã được tự động gộp: 8/6/18

Trường hợp em muốn copy paste value mảng B5:H10 thì thay đổi code dưới như thế nào ạ.
Em thử record rồi nhưng vẫn chưa hiểu được.
Các bác hướng dẫn giúp ạ.

Private Sub Workbook_Open()
Application.DisplayAlerts = False
Workbooks.Open ThisWorkbook.Path & "\Data.xls"
ActiveWorkbook.ActiveSheet.Cells.Copy ThisWorkbook.ActiveSheet.[A1]
ActiveWorkbook.Close False
Application.DisplayAlerts = True
End Sub

Bài đã được tự động gộp: 8/6/18

Trường hợp em muốn thay copy paste dưới bằng copy paste value thì sửa code thế nào ạ.
Các bác hướng dẫn giúp em nhé.
Em cảm ơn.

Private Sub Workbook_Open()
Application.DisplayAlerts = False
Workbooks.Open ThisWorkbook.Path & "\Data.xls"
ActiveWorkbook.ActiveSheet.Cells.Copy ThisWorkbook.ActiveSheet.[A1]
ActiveWorkbook.Close False
Application.DisplayAlerts = True
End Sub

 

[kimdong_vfu]

Thử chạy code này:

Public Sub Update_CSDL()
Dim sArr(), tArr(), I As Long, J As Long, Rws As Long, R As Long, Txt As String
tArr = Sheets("Thongtin").Range("A2", Sheets("Thongtin").Range("A2").End(xlDown)).Resize(, 45).Value
With CreateObject("Scripting.Dictionary")
    For I = 1 To UBound(tArr)
        .Item(tArr(I, 1) & "#" & tArr(I, 2)) = I
    Next I
    sArr = Sheets("CSDL").Range("A2", Sheets("CSDL").Range("A2").End(xlDown)).Resize(, 45).Value
    R = UBound(sArr)
    For I = 1 To R
        Txt = sArr(I, 1) & "#" & sArr(I, 2)
        If .Exists(Txt) Then
            Rws = .Item(Txt)
            For J = 13 To 32
                sArr(I, J) = tArr(Rws, J)
            Next J
        End If
    Next I
End With
Sheets("CSDL").Range("A2").Resize(R, 45) = sArr
End Sub

Cảm ơn bác. Nhưng các cột từ AG đến AS không cập nhập dữ liệu được. Bác kiểm tra lại hộ em với.

 

[mtuan]

Dạ e hiểu rồi Để em nhập xong xem thế nào.à mà cái button nhập khi nhấn 1 lần tự mờ a xem giúp code dùm e với nha. Cảm ơn A nhiều

Dạ chào Bạn giaiphap. Code rất ok đã đúng ý mình. cảm ơn bạn nhiều
Nhưng hôm nhờ quên đưa vào cột thành tiền. khi mình lọc xổ ra các KH theo trợ giá và tại cột L sẽ tổng tiền của các khách hàng trong loại trợ giá trên.
cái nữa là cột ngày chưa hiển thị ra ngày mà vẫn ra số ạ.
Nhờ bạn giành tí thời gian giúp mình nha. Cảm ơn rất nhiều

 

[giaiphap]

Up file đó lên đây xem thử và đưa một số dữ liệu mẫu. Nhớ là file thật của bạn và cần tính gì nêu hết lên, chứ kiểu này công việc của bạn không xong mà công sức anh em giúp đỡ chẳng có kết quả gì.

 

[cao2606]

Em chào anh chị,
Anh chị giúp em viết code để tìm hệ số tương quan trong Mô hình hồi quy tuyến tính đa biến này với ạ. Em cảm ơn ạ

 

[mtuan]

Up file đó lên đây xem thử và đưa một số dữ liệu mẫu. Nhớ là file thật của bạn và cần tính gì nêu hết lên, chứ kiểu này công việc của bạn không xong mà công sức anh em giúp đỡ chẳng có kết quả gì.

dạ rồi tối e gửi cho ạ. Cảm ơn rất nhiều

 

[HieuCD]

Em chào anh chị,
Anh chị giúp em viết code để tìm hệ số tương quan trong Mô hình hồi quy tuyến tính đa biến này với ạ. Em cảm ơn ạ

=INDEX(LINEST(A2:A33,B2:E33,,TRUE),3,1)
Mở Help Excel xem hướng dẫn

 

[gen_bidv]

Chào các bác
Em đang lấy dữ liệu từ một Sheet bằng câu lệnh SQL mà bị lỗi này chưa xử lý được, nhờ các bác hỗ trợ.
Mô tả:
- Dữ liệu nằm ở Sheet 1 (em để tạm một cột CIF)
- Câu lệnh đang để ở Sheet 2
- Dữ liệu đầu ra ở Sheet 3
Tuy nhiên khi chạy thì dữ liệu đầu ra chỉ có hơn 20.000 dòng trong khi dữ liệu đầu vào là hơn 400.000 dòng (câu lệnh lấy toàn bộ dữ liệu).
Rất mong các bác giúp đỡ, xin cảm ơn.

 

[AutoReply]

Chào các bác
Em đang lấy dữ liệu từ một Sheet bằng câu lệnh SQL mà bị lỗi này chưa xử lý được, nhờ các bác hỗ trợ.
Mô tả:
- Dữ liệu nằm ở Sheet 1 (em để tạm một cột CIF)
- Câu lệnh đang để ở Sheet 2
- Dữ liệu đầu ra ở Sheet 3
Tuy nhiên khi chạy thì dữ liệu đầu ra chỉ có hơn 20.000 dòng trong khi dữ liệu đầu vào là hơn 400.000 dòng (câu lệnh lấy toàn bộ dữ liệu).
Rất mong các bác giúp đỡ, xin cảm ơn.

Nghe nói chuỗi kết nối nên sửa thành

cn.Open ("Provider=Microsoft.ACE.OLEDB.12.0;" & _
             "Data Source=" & Wbsk.FullName & _
             ";Extended Properties=""Excel 12.0;HDR=Yes;readOnly=true"";")

 

[Sunbinsuzin]

Nhờ các bác chuyển hộ em từ hàm trong FILE KetQua qua vba với ạ vì dùng hàm mỗi lần cập nhật hay sửa dữ liệu thì Excel cứ đơ ra chạy rất rất lâu mới cho ra kết quả.

Em xin nói thông tin về 3 FILE của em chút
FILE Gia có Tên ---- PO-----Giá
File PO có Tên --------PO-------Số lượng
File Ketqua có Tên.

Em lấy PO ở FILE PO điều kiện mà max số lượng, lấy giá ở fie giá điều kiện là Tên và PO, khi sảy ra lỗi thì kết quả là " Không tìm thấy dữ liệu".

Trong FILE em giử lên em đã bỏ đi hàm iferror khi để các bác nhìn cho đỡ rối ạ.

Nếu được các bác cải tiến dùm em là khi mở file ketqua thì tự động Copy sheet nằm ở vị trí đầu tiên của file PO và Copy Sheet nằm ở vị trí đầu của file Gia vào trong FILE KetQua và trong FILE KetQua khi em nhập thêm Tên thì cột PO SoLuong và Gia tự động hiện kết quả a.

Khi đóng file hoặc khi mở file thì việc đầu tiên là xoá 2 Sheet Copy đó đi vì em sợ nếu 2 file kia có vấn đề gì đó ko Copy qua được thì khi nhập Tên vào thì kết quả trả về là dữ liệu đã cũ rồi ạ.

Thêm 1 rắc rối nữa là FILE Gia có 2 lớp pass như trong FILE em UP và thường có 1 cái thông báo Link hỏng vậy các bác có thể thêm luôn Password vào code cho em được ko ạ. Nếu Password đúng từ Copy, nếu Password ko đúng thì mở hộp thoại thông báo sai Password or mở cái hộp thoại nhập Password cũng được ạ.

Thêm code kiểm 2 file PO và Gia có tồn tại ko nữa ạ nếu tồn tại thì Copy ko tồn tại thì báo không tìm thấy FILE ạ.
Password file Gia là: 2 số 1 và 1 số ạ
11
1
Thank các bán trước

 

[mtuan]

Up file đó lên đây xem thử và đưa một số dữ liệu mẫu. Nhớ là file thật của bạn và cần tính gì nêu hết lên, chứ kiểu này công việc của bạn không xong mà công sức anh em giúp đỡ chẳng có kết quả gì.

dạ chào Anh
file em up lên là file em đang làm đó A, và em có chỉnh lại font trong code là VNI-TIME và em sẽ chịu khó sau khi lọc xong định dạng lại cũng dc. trước đây nhập tay vào bảng kê giờ thì quá tuyệt rồi. Chỉ cần nhờ Sư phụ giúp cho làm cthức cho cột thành tiền và Tổng tiền của từng loại trợ giá nữa là tuyệt vời ạ.
Những chổ em tô đỏ là sửa giúp, còn chổ tô xanh là ok rồi ạ.
Chân thành cảm ơn sự nhiệt tình giúp đỡ của Anh.
e vừa nhập thử thì lọc ra ở cột trợ giá lọc từ M2 nhưng nếu 13 KH +5dong thì lúc này chỉ lọc 12 KH thôi anh ơi. Akiểm tra và A test dùm e. a giúp e xong e mới về nhập lại vì file trước của e ko lưu và làm bằng tay và mỗi ngày là 1 sheet.

 

[Ba Tê]

Cảm ơn bác. Nhưng các cột từ AG đến AS không cập nhập dữ liệu được. Bác kiểm tra lại hộ em với.

Đã kiểm tra và đúng yêu cầu:

Giờ mình muốn thế này. Nếu thông tin ở Cột A và Cột B của Sheet "CSDL" và sheet "Thongtin" giống nhau thì các thông tin từ cột M đến cột AF
của sheet "Thongtin" nó sẽ copy nhặt sang sheet "CSDL"

Chỗ nào nói tới cột AG:AS ?

 

[gen_bidv]

Nghe nói chuỗi kết nối nên sửa thành

cn.Open ("Provider=Microsoft.ACE.OLEDB.12.0;" & _
             "Data Source=" & Wbsk.FullName & _
             ";Extended Properties=""Excel 12.0;HDR=Yes;readOnly=true"";")

Cảm ơn bro nhé, nhưng những lỗi này cũng lạ nhỉ, nhiều khi không phát hiện nổi.
Đối với câu lệnh SQL, tôi còn gặp một lỗi nữa đó là khi dữ liệu một cột là số (Number), nếu dòng đầu tiên của cột đó có giá trị rỗng, khi Select ra toàn bộ cột đó rỗng luôn, nghĩ mãi đến giờ vẫn chưa hiểu nguyên nhân, chắc thử thay đổi lại kết nối xem sao.

Tks again,

 

[giaiphap]

dạ chào Anh
file em up lên là file em đang làm đó A, và em có chỉnh lại font trong code là VNI-TIME và em sẽ chịu khó sau khi lọc xong định dạng lại cũng dc. trước đây nhập tay vào bảng kê giờ thì quá tuyệt rồi. Chỉ cần nhờ Sư phụ giúp cho làm cthức cho cột thành tiền và Tổng tiền của từng loại trợ giá nữa là tuyệt vời ạ.
Những chổ em tô đỏ là sửa giúp, còn chổ tô xanh là ok rồi ạ
Chân thành cảm ơn sự nhiệt tình giúp đỡ của Anh.

Bạn xem thử file.

 

[mtuan]

Bạn xem thử file.

Dạ cảm ơn Anh nhiều quá. quá tuyệt anh ơi. thế là ok rồi.
một lần nữa chân thành cảm ơn anh.
có thể cho e xin số điện thoại không ạ
cho em hỏi thêm tí ạ trong code đoạn nào làm cho tự vẽ khung và ubound, lbound là gì vậy A

 

[giaiphap]

Dạ cảm ơn Anh nhiều quá. quá tuyệt anh ơi. thế là ok rồi.
một lần nữa chân thành cảm ơn anh.
có thể cho e xin số điện thoại không ạ
cho em hỏi thêm tí ạ trong code đoạn nào làm cho tự vẽ khung và ubound, lbound là gì vậy A

Tôi không có dùng điện thoại nhé bạn!

 

[Phongluubg]

Nhờ giúp đỡ. Mình đang cần sửa file bán hàng này lại cho phù hợp với mình. Mình cần bỏ mục "Số Đôi", thêm Vô mục Tên sản phẩm, khi nhập 1 sản phẩm thì phải nhập mục chiết khấu (mục chiết khấu có 2 tùy chọn là nhâp theo % hoặc nhập theo số tiền. Khi in phiếu ra có mục trừ chiết khấu (làm tròn không lấy số lẻ thâp phân), sheet NKxuatthang có cột trừ chiết khấu. em xin cảm ơn ạ.