Giúp mình chỉnh sữa Code (1 người xem)

[bogay]

Mình vừa tập tành VBA, hôm nay thử làm đoạn code link đơn giá từ Sheets("DGCT") sang Sheets("Duthau"). Cũng đã chạy được rồi nhưng có một vấn đề xẩy ra là khi chạy tới Cells rỗng thì lại dừng lại không chạy nữa. Mình nhờ các bác xem thử Code mình lập đã ổn chưa và khắc phục lỗi khi gặp Cells rỗng nhé. Mình xin cám ơn!
Đây là Code mình lập:
Sub LinkDG()
Dim sRng As Range, Clls As Range, Rng As Range
On Error Resume Next
Sheets("Duthau").Select
Set Rng = Worksheets("DGCT").Range("B6:B500")
For Each Clls In Range([B7], [B7].End(xlDown))
Set sRng = Rng.Find(Clls.Value)
If Clls.Value = sRng.Value Then
Clls.Offset(, 4).Value = "=DGCT!" & sRng.Offset(, 8).Address(0, 0)
End If
Next
End Sub

 

[Quang_Hải]

Mình vừa tập tành VBA, hôm nay thử làm đoạn code link đơn giá từ Sheets("DGCT") sang Sheets("Duthau"). Cũng đã chạy được rồi nhưng có một vấn đề xẩy ra là khi chạy tới Cells rỗng thì lại dừng lại không chạy nữa. Mình nhờ các bác xem thử Code mình lập đã ổn chưa và khắc phục lỗi khi gặp Cells rỗng nhé. Mình xin cám ơn!
Đây là Code mình lập:
Sub LinkDG()
Dim sRng As Range, Clls As Range, Rng As Range
On Error Resume Next
Sheets("Duthau").Select
Set Rng = Worksheets("DGCT").Range("B6:B500")
For Each Clls In Range([B7], [B7].End(xlDown))
Set sRng = Rng.Find(Clls.Value)
If Clls.Value = sRng.Value Then
Clls.Offset(, 4).Value = "=DGCT!" & sRng.Offset(, 8).Address(0, 0)
End If
Next
End Sub

Không có xem file bạn nhưng mình thấy chỗ này nên sửa lại

For Each Clls In Range([B7], [B7].End(xlDown))

Sửa lại thế này

For Each Clls In Range([B7], [B65536].End(3))

 

[bogay]

Có file Vidu đính kèm mà bạn ơi!

 

[viehoai]

1. Bạn sửa theo như anh quanghai1969 đã nói
2.

Set sRng = Rng.Find(Clls.Value)
If Clls.Value = sRng.Value Then
Clls.Offset(, 4).Value = "=DGCT!" & sRng.Offset(, 8).Address(0, 0)
End If

bạn có thể sửa

 Set sRng = Rng.Find(Clls.Value)
      If Not sRng Is Nothing Then
         Clls.Offset(, 4).Value = "=DGCT!" & sRng.Offset(, 8).Address(0, 0)
      End If

Vì khi bạn có kệnh tìm kiếm (Find) thì nó có tồn tại hay không tồn tai
3. Bạn lường trường hợp code chỉ thực hiện lệnh tìm kiếm khi Clls.Value <> "" (vbNullString)
Chúc bạn thành công

 

[Quang_Hải]

Mình vừa tập tành VBA, hôm nay thử làm đoạn code link đơn giá từ Sheets("DGCT") sang Sheets("Duthau"). Cũng đã chạy được rồi nhưng có một vấn đề xẩy ra là khi chạy tới Cells rỗng thì lại dừng lại không chạy nữa. Mình nhờ các bác xem thử Code mình lập đã ổn chưa và khắc phục lỗi khi gặp Cells rỗng nhé. Mình xin cám ơn!

Bạn thử thay code này vào xem kết quả có đúng như ý của bạn không.

Sub LinkDG()
  Dim kq(), i, j, dl()
   With Sheets("Duthau")
    kq = .Range(.[B7], .[B65536].End(3)).Resize(, 5).Value
   End With
    With Sheets("DGCT")
        dl = .Range(.[B6], .[B65536].End(3)).Resize(, 9).Value
    End With
    For i = 1 To UBound(kq)
      For j = 1 To UBound(dl)
         If kq(i, 1) = dl(j, 1) Then
            kq(i, 5) = dl(j, 9)
            Exit For
         End If
      Next
   Next
Sheets("Duthau").[B7].Resize(i - 1, 5) = kq
End Sub

 

[viehoai]

Bạn thử thay code này vào xem kết quả có đúng như ý của bạn không.

Sub LinkDG()
  Dim kq(), i, j, dl()
   With Sheets("Duthau")
    kq = .Range(.[B7], .[B65536].End(3)).Resize(, 5).Value
   End With
    With Sheets("DGCT")
        dl = .Range(.[B6], .[B65536].End(3)).Resize(, 9).Value
    End With
    For i = 1 To UBound(kq)
      For j = 1 To UBound(dl)
         If kq(i, 1) = dl(j, 1) Then
            kq(i, 5) = dl(j, 9)
            Exit For
         End If
      Next
   Next
Sheets("Duthau").[B7].Resize(i - 1, 5) = kq
End Sub

1. Tác giả muốn kết quả là Link đơn giá đến một địa chỉ ở Sheet DGCT
2. Bạn xem lại chẳng lẻ mã có ký tự trống có đều có đơn giá là 527727,2988 ???

 

[bogay]

Mình chạy thử Code của bạn, mình thấy có 2 vấn đề xẩy ra:
Thứ nhất: Kết quả là số chết (có đường link thì hay nhất bạn à)
Thứ 2: Cột B ở Sheets("Duthau") có Cells bị rỗng thì vẫn cho ra kết quả.
Bạn sửa 2 vấn đề trên tý nữa thì mình nghĩ là OK. Mình cám ơn bạn.

 

[viehoai]

Mình chạy thử Code của bạn, mình thấy có 2 vấn đề xẩy ra:
Thứ nhất: Kết quả là số chết (có đường link thì hay nhất bạn à)
Thứ 2: Cột B ở Sheets("Duthau") có Cells bị rỗng thì vẫn cho ra kết quả.
Bạn sửa 2 vấn đề trên tý nữa thì mình nghĩ là OK. Mình cám ơn bạn.

Theo như trên mình đã nói thì bạn có thể sửa

Sub LinkDG()  Dim sRng As Range, Clls As Range, Rng As Range
   On Error Resume Next
    For Each Clls In Range([B7], [B65500].End(3))
     If Clls.Value <> "" Then
      Set sRng = Worksheets("DGCT").Range("B6:B500").Find(Clls.Value)
      If Not sRng Is Nothing Then
         Clls.Offset(, 4).Value = "=DGCT!" & sRng.Offset(, 8).Address(0, 0)
      End If
     End If
    Next
   Set sRng = Nothing
End Sub

 

[Quang_Hải]

Mình chạy thử Code của bạn, mình thấy có 2 vấn đề xẩy ra:
Thứ nhất: Kết quả là số chết (có đường link thì hay nhất bạn à)
Thứ 2: Cột B ở Sheets("Duthau") có Cells bị rỗng thì vẫn cho ra kết quả.
Bạn sửa 2 vấn đề trên tý nữa thì mình nghĩ là OK. Mình cám ơn bạn.

Vầy cũng không khác code của lúc đầu của bạn. Nếu dữ liệu nhiều mà mình xử lý trên sheet thì hơi chậm tí

Sub LinkDG()
On Error Resume Next
  Dim kq(), i As Long, dl As Object
   With Sheets("Duthau")
    kq = .Range(.[B7], .[B65536].End(3)).Resize(, 5).Value
   End With
    With Sheets("DGCT")
        Set dl = .Range(.[B6], .[B65536].End(3))
    End With
    For i = 1 To UBound(kq)
      If kq(i, 1) <> "" Then
         kq(i, 5) = "=DGCT!" & dl.Find(kq(i, 1)).Offset(, 8).Address(0, 0)
      End If
   Next
Sheets("Duthau").[B7].Resize(i - 1, 5) = kq
End Sub

 

[bogay]

Mình cám ơn các bạn rất nhiều! Càng làm mình càng thấy VBA rất là thú vị.