Nhờ sửa lỗi code VBA (2 người xem)

swalowbird · 14/4/17

Các bác sửa lỗi giúp em code tìm kiếm thay Vlook up này

Lỗi ở chỗ khi em lấy vùng điều kiện là 1 ô thì xảy ra lỗi ở đoạn code này

sArr = rng1.Value

giúp em với

Option Explicit

Sub vtk()
Dim dong As Range
Dim rng1 As Range
Dim rng2 As Range
Dim rng As Range
Dim K As Integer

Set rng1 = Application.InputBox(Prompt:="chon vung dieu kien ", Title:="Range Select", Type:=8)

Set rng2 = Application.InputBox(Prompt:="chon vung tham chieu ", Title:="Range Select", Type:=8)

Set rng = Application.InputBox(Prompt:="chon vung tra ket qua ", Title:="Range Select", Type:=8)

Dim sArr() As Variant, i As Long
Dim kArr() As Variant, j As Long
ReDim kArr(1 To 1000, 1)
i = j
sArr = rng1.Value

K = InputBox(" Nhap so cot du lieu ", " nhap k")

With rng2
For i = 1 To UBound(sArr)
Set dong = rng2.Find(sArr(i, 1), , xlFormulas, xlWhole)
If Not dong Is Nothing Then
j = i
kArr(i, 1) = dong.offset(0, K).Value
End If
Next i
End With

With rng
For j = 1 To UBound(sArr)
rng.Cells(j, 1) = kArr(j, 1)
Next j

End With

End Sub

HieuCD · 14/4/17

Mã:

Sub vtk()
Dim dong As Range, rng1 As Range, rng2 As Range, rng As Range
Dim K As Integer, i As Long
Set rng1 = Application.InputBox(Prompt:="chon vung dieu kien ", Title:="Range Select", Type:=8)
Set rng2 = Application.InputBox(Prompt:="chon vung tham chieu ", Title:="Range Select", Type:=8)
Set rng = Application.InputBox(Prompt:="chon vung tra ket qua ", Title:="Range Select", Type:=8)
K = InputBox(" Nhap so cot du lieu ", " nhap k")
With rng2
  For i = 1 To rng1.Count
    Set dong = rng2.Find(rng1(i, 1), , xlFormulas, xlWhole)
    If Not dong Is Nothing Then
      rng.Cells(i, 1) = dong.Offset(0, K).Value
      'rng.Cells(i, 1) = dong.Offset(0, K - 1).Value 'có le nên dùng lênh này
    End If
  Next i
End With
End Sub

HieuCD · 14/4/17

nếu muốn chạy nhanh hơn thì

Mã:

Sub vtk()
Dim FindRng As Range, DataRng As Range, Tmp As Range, Rng As Range
Dim Arr As Variant, K As Integer, i As Long, R As Long
Set FindRng = Application.InputBox(Prompt:="chon vung dieu kien ", Title:="Range Select", Type:=8)
Set DataRng = Application.InputBox(Prompt:="chon vung tham chieu ", Title:="Range Select", Type:=8)
Set Rng = Application.InputBox(Prompt:="chon vung tra ket qua ", Title:="Range Select", Type:=8)
K = InputBox(" Nhap thu tu cot lay ket qua ", " nhap k")
R = FindRng.Count
ReDim Arr(1 To R, 1 To 1)
For i = 1 To R
  Set Tmp = DataRng.Find(FindRng(i, 1), , xlFormulas, xlWhole)
  If Not Tmp Is Nothing Then
      Arr(i, 1) = Tmp.Offset(0, K - 1).Value
  End If
Next i
Rng.Resize(R) = Arr
End Sub

swalowbird · 14/4/17

Bác có cách nào dùng cho 2 workbook không ?

thanks !

befaint · 14/4/17

HieuCD đã viết:
nếu muốn chạy nhanh hơn thì

Anh chưa bẫy lỗi kìa...

NguyenNgocThuHien · 14/4/17

Sao không dùng cái Application.WorksheetFunction.VLookup, dùng find làm gì cơ chứ.

HieuCD · 14/4/17

befaint đã viết:
Anh chưa bẫy lỗi kìa...

ban đầu mình cũng bẩy lổi, nhưng quá nhiều dạng và nhìn rối quá nên bỏ luôn

HieuCD · 14/4/17

swalowbird đã viết:
Bác có cách nào dùng cho 2 workbook không ?

thanks !

chạy thử code

Mã:

Sub GPE()
Dim MainWb As Workbook, Wb As Workbook, FindRng As Range, DataRng As Range, Tmp As Range, Rng As Range
Dim Msg, Style, Title, Response, strPath, Fname
Dim Arr As Variant, K As Integer, i As Long, R As Long
On Error GoTo Thoat
Set FindRng = Application.InputBox(Prompt:="chon vung dieu kien ", Title:="Range Select", Type:=8)
Msg = "Do you want to get Data from Other WorkBook ?"
Style = vbYesNo + vbCritical + vbDefaultButton2
Title = "MsgBox Choose File"
Response = MsgBox(Msg, Style, Title)
If Response = vbYes Then
  Set MainWb = ThisWorkbook
  strPath = ""
  Fname = GetFile(strPath)
  If Fname <> "" Then Set Wb = Workbooks.Open(Fname)
End If
Set DataRng = Application.InputBox(Prompt:="chon vung tham chieu ", Title:="Range Select", Type:=8)
If Fname <> "" Then MainWb.Activate
Set Rng = Application.InputBox(Prompt:="chon vung tra ket qua ", Title:="Range Select", Type:=8)
K = InputBox(" Nhap thu tu cot lay ket qua ", " nhap k")
R = FindRng.Count
ReDim Arr(1 To R, 1 To 1)
For i = 1 To R
  Set Tmp = DataRng.Find(FindRng(i, 1), , xlFormulas, xlWhole)
  If Not Tmp Is Nothing Then
      Arr(i, 1) = Tmp.Offset(0, K - 1).Value
  End If
Next i
Rng.Resize(R) = Arr
If Fname <> "" Then Wb.Close False
Thoat:
End Sub
Function GetFile(ByVal strPath As String) As String
Dim Fldr As FileDialog, sItem As String
Set Fldr = Application.FileDialog(msoFileDialogFilePicker)
With Fldr
    .AllowMultiSelect = False
    .InitialFileName = strPath
    .Filters.Add "Images", "*.xls*"
    If .Show <> -1 Then GoTo NextCode
    sItem = .SelectedItems(1)
End With
NextCode:
GetFile = sItem
Set Fldr = Nothing
End Function

Hoang2013 · 15/4/17

Phương thức FIND() sẽ nhanh & hiệu quả hơn VLOOKUP() trong những trường hợp này (Do sự thanh thoát đem lại).

& Đương nhiên cách bẩy lỗi trong FIND() sẽ phải khác hơn trong VLOOKUP(), nhưng nhất thiết sẽ phải bẩy lỗi!

AutoReply · 15/4/17

NguyenNgocThuHien đã viết:
Sao không dùng cái Application.WorksheetFunction.VLookup, dùng find làm gì cơ chứ.

Bạn nói đúng đấy. Mình ủng hộ bạn. Phụ nữ luôn đúng mà. }}}}}

Ai bảo bạn nói sai cứ liên hệ mình, và người đó chỉ cần trả lời câu hỏi : dùng Vlookup khỏi cần Workbooks.Open, khỏi cần vòng lặp. Dùng Find có làm được thế không ? hihi --=0

NguyenNgocThuHien · 15/4/17

Hoang2013 đã viết:
Phương thức FIND() sẽ nhanh & hiệu quả hơn VLOOKUP() trong những trường hợp này (Do sự thanh thoát đem lại).

& Đương nhiên cách bẩy lỗi trong FIND() sẽ phải khác hơn trong VLOOKUP(), nhưng nhất thiết sẽ phải bẩy lỗi!

Mình chưa hiểu sư thanh thoát mà bạn nói đến, vlookup tìm kiếm theo dữ liệu, nó có 4 đối số, find là một phương thức tìm kiếm theo rất nhiều chỉ tiêu ( dữ liệu, định dạng), nó có tận 9 đối số. Do vậy về độ nhanh mình nghĩ nó không hơn vlookup. Chưa kể phương thức find sẽ ảnh hưởng tới thiết lập của hộp thoại Find.

swalowbird · 7/6/17

HieuCD đã viết:

chạy thử code

Mã:

Sub GPE()
Dim MainWb As Workbook, Wb As Workbook, FindRng As Range, DataRng As Range, Tmp As Range, Rng As Range
Dim Msg, Style, Title, Response, strPath, Fname
Dim Arr As Variant, K As Integer, i As Long, R As Long
On Error GoTo Thoat
Set FindRng = Application.InputBox(Prompt:="chon vung dieu kien ", Title:="Range Select", Type:=8)
Msg = "Do you want to get Data from Other WorkBook ?"
Style = vbYesNo + vbCritical + vbDefaultButton2
Title = "MsgBox Choose File"
Response = MsgBox(Msg, Style, Title)
If Response = vbYes Then
  Set MainWb = ThisWorkbook
  strPath = ""
  Fname = GetFile(strPath)
  If Fname <> "" Then Set Wb = Workbooks.Open(Fname)
End If
Set DataRng = Application.InputBox(Prompt:="chon vung tham chieu ", Title:="Range Select", Type:=8)
If Fname <> "" Then MainWb.Activate
Set Rng = Application.InputBox(Prompt:="chon vung tra ket qua ", Title:="Range Select", Type:=8)
K = InputBox(" Nhap thu tu cot lay ket qua ", " nhap k")
R = FindRng.Count
ReDim Arr(1 To R, 1 To 1)
For i = 1 To R
  Set Tmp = DataRng.Find(FindRng(i, 1), , xlFormulas, xlWhole)
  If Not Tmp Is Nothing Then
      Arr(i, 1) = Tmp.Offset(0, K - 1).Value
  End If
Next i
Rng.Resize(R) = Arr
If Fname <> "" Then Wb.Close False
Thoat:
End Sub
Function GetFile(ByVal strPath As String) As String
Dim Fldr As FileDialog, sItem As String
Set Fldr = Application.FileDialog(msoFileDialogFilePicker)
With Fldr
    .AllowMultiSelect = False
    .InitialFileName = strPath
    .Filters.Add "Images", "*.xls*"
    If .Show <> -1 Then GoTo NextCode
    sItem = .SelectedItems(1)
End With
NextCode:
GetFile = sItem
Set Fldr = Nothing
End Function

Dùng giữa 2 workbook đnag mở thì sao bác ????

HieuCD · 7/6/17

swalowbird đã viết:
Dùng giữa 2 workbook đnag mở thì sao bác ????

bạn chạy thử code chưa, có hộp thoại chọn file khác coi như mở lần 2 thôi, xong thì đóng lại

phuyen89 · 7/6/17

swalowbird đã viết:
Các bác sửa lỗi giúp em code tìm kiếm thay Vlook up này

Lỗi ở chỗ khi em lấy vùng điều kiện là 1 ô thì xảy ra lỗi ở đoạn code này

sArr = rng1.Value

giúp em với

Option Explicit

Sub vtk()
Dim dong As Range
Dim rng1 As Range
Dim rng2 As Range
Dim rng As Range
Dim K As Integer

Set rng1 = Application.InputBox(Prompt:="chon vung dieu kien ", Title:="Range Select", Type:=8)

Set rng2 = Application.InputBox(Prompt:="chon vung tham chieu ", Title:="Range Select", Type:=8)

Set rng = Application.InputBox(Prompt:="chon vung tra ket qua ", Title:="Range Select", Type:=8)

Dim sArr() As Variant, i As Long
Dim kArr() As Variant, j As Long
ReDim kArr(1 To 1000, 1)
i = j
sArr = rng1.Value

K = InputBox(" Nhap so cot du lieu ", " nhap k")

With rng2
For i = 1 To UBound(sArr)
Set dong = rng2.Find(sArr(i, 1), , xlFormulas, xlWhole)
If Not dong Is Nothing Then
j = i
kArr(i, 1) = dong.offset(0, K).Value
End If
Next i
End With

With rng
For j = 1 To UBound(sArr)
rng.Cells(j, 1) = kArr(j, 1)
Next j

End With

End Sub

Mình viết thế này, bạn tham khảo.

PHP:

Sub abc()
    Dim ws As Worksheet
    Dim i As Integer
    Set ws = Worksheets("Data")
    Dim c As Range
    For i = 5 To 11
        Set c = ws.Range("B4:B11").Find(Cells(i, 2).Value)
        If Not c Is Nothing Then
            Cells(i, 3).Value = c.Offset(0, 1).Value
        Else
            Cells(i, 3).Value = "Error"
        End If
     
    Next i
End Sub

phuyen89 · 7/6/17

NguyenNgocThuHien đã viết:
Mình chưa hiểu sư thanh thoát mà bạn nói đến, vlookup tìm kiếm theo dữ liệu, nó có 4 đối số, find là một phương thức tìm kiếm theo rất nhiều chỉ tiêu ( dữ liệu, định dạng), nó có tận 9 đối số. Do vậy về độ nhanh mình nghĩ nó không hơn vlookup. Chưa kể phương thức find sẽ ảnh hưởng tới thiết lập của hộp thoại Find.

- Bạn kéo dữ liệu tới tầm 100.000 dòng, rồi đo tốc độ thử xem, là biết cách nào nhanh hơn thôi.Đó, đôi khi cũng là 01 cách thử.

babyheomoi · 8/6/17

Theo trình gà vba của e đoán là bác chưa Dim sArr @@

SA_DQ · 8/6/17

(1) Mình chưa hiểu sư thanh thoát mà bạn nói đến,
(2) Vlookup tìm kiếm theo dữ liệu, nó có 4 đối số, find là một phương thức tìm kiếm theo rất nhiều chỉ tiêu ( dữ liệu, định dạng), nó có tận 9 đối số. Do vậy về độ nhanh mình nghĩ nó không hơn vlookup.
Chưa kể phương thức find sẽ ảnh hưởng tới thiết lập của hộp thoại Find.

(1) Thanh thoát là với macro bài đầu thôi;
(2) Find() là phương tưức có nhiều tùy chọn; Nếu không muốn ta có thể bỏ qua chúng mà;
Bạn có khi nào thấy câu lệnh này chưa:

Mã:

 Rng.Find("GPE.COM")

chưa?

HieuCD · 8/6/17

NguyenNgocThuHien đã viết:
Sao không dùng cái Application.WorksheetFunction.VLookup, dùng find làm gì cơ chứ.

mình chỉ giúp chỉnh sửa code của chủ Topic thôi, giúp bạn ấy biết cách dùng phương thức Find, còn viết theo ý mình thì không dùng Find cũng như Vlookup, mình gặp nhiều trường hợp dữ liệu và số kết quả lớn code chạy khá chậm

HieuCD · 8/6/17

AutoReply đã viết:
Bạn nói đúng đấy. Mình ủng hộ bạn. Phụ nữ luôn đúng mà.
Ai bảo bạn nói sai cứ liên hệ mình, và người đó chỉ cần trả lời câu hỏi : dùng Vlookup khỏi cần Workbooks.Open, khỏi cần vòng lặp. Dùng Find có làm được thế không ? hihi

Mình là nam nhi nên đồng ý châm ngôn "Phụ nữ luôn đúng" khà khà khà
Bài nầy không mở file thì làm sao biết vùng dữ liệu ở file nào, nằm ở sheet nào, địa chỉ vùng dữ liệu? không lẽ nhập trực tiếp vào Msg box, khả năng nhập 10 lần sai 9 lần

Hoang2013 · 9/6/17

Mình cho rằng tác giả bài đăng viết Code theo kiểu: "Chưa đậu ông nghè đã đe hàng tổng"

Nhờ sửa lỗi code VBA (2 người xem)

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

Thành viên mới

File đính kèm

Chuyên gia GPE

Chuyên gia GPE

Thành viên mới

|||||||||||||

Cute Black Cat

Chuyên gia GPE

Chuyên gia GPE

Thành viên gắn bó

Thành viên tiêu biểu

Cute Black Cat

Thành viên mới

Chuyên gia GPE

Thành viên tích cực

File đính kèm

Thành viên tích cực

Thành viên thường trực

/(hông là gì!

Chuyên gia GPE

Chuyên gia GPE

Thành viên gắn bó

Đếm ngược thời gian