Cập nhật dữ liệu vào những ô trống còn những ô có giá trị thì giữ nguyên (1 người xem)

HocVBAExcel · 5/3/16

Hiện tại mình cập nhật giữ liệu từ vùng Q5:S8 qua cột J
Mình muốn bổ sung thêm điều kiện chỉ cập nhật vào những ô trống
Ví dụ như cột J5 là chữ GIỮ NGUYÊN khi nhấn nút lệnh chứ không phài là A .Mình gửi file đính kèm các anh Chị hỗ trợ.
File đưa lên không được mình gửi link sau nhờ các anh giúp.
http://www.fshare.vn/file/YIE7GFJ3MJKX
mình áp dụng code sau

Mã:

Private Sub CommandButton1_Click()
Dim Arr(), Darr(), Dic, i As Long, J As Long, Tem As String
Set Dic = CreateObject("Scripting.Dictionary")
With Sheet1
Arr = .Range(.[Q5], .[Q65500].End(xlUp)).Resize(, 3).Value2
End With
For i = 1 To UBound(Arr, 1)
    Tem = Arr(i, 1) & Arr(i, 2)
    If Not Dic.exists(Tem) Then
        Dic.Add Tem, Arr(i, 3)
    End If
Next i
With Sheet1
Darr = .Range(.[C5], .[C65500].End(xlUp)).Resize(, 9).Value
End With
For i = 1 To UBound(Darr, 1)
  Tem = Darr(i, 1) & Darr(i, 9)
 
  If Dic.exists(Tem) Then
        Darr(i, 1) = Dic.Item(Tem)
       Else
         Darr(i, 1) = IIf(Darr(i, 9) = "", Darr(i, 2), "")
       End If
       
Next i
With Sheet1


.[J5].Resize(i - 1) = Darr


End With
Set Dic = Nothing
End Sub

SA_DQ · 5/3/16

Máy của mình nó báo tập tin có sâu hay con ngựa gì đó, kiếp!

nghiaphuc · 5/3/16

HocVBAExcel đã viết:
Hiện tại mình cập nhật giữ liệu từ vùng Q5:S8 qua cột J
Mình muốn bổ sung thêm điều kiện chỉ cập nhật vào những ô trống
Ví dụ như cột J5 là chữ GIỮ NGUYÊN khi nhấn nút lệnh chứ không phài là A .Mình gửi file đính kèm các anh Chị hỗ trợ.
File đưa lên không được mình gửi link sau nhờ các anh giúp.
http://www.fshare.vn/file/YIE7GFJ3MJKX
mình áp dụng code sau

Mã:

Private Sub CommandButton1_Click() Dim Arr(), Darr(), Dic, i As Long, J As Long, Tem As String Set Dic = CreateObject("Scripting.Dictionary") With Sheet1 Arr = .Range(.[Q5], .[Q65500].End(xlUp)).Resize(, 3).Value2 End With For i = 1 To UBound(Arr, 1) Tem = Arr(i, 1) & Arr(i, 2) If Not Dic.exists(Tem) Then Dic.Add Tem, Arr(i, 3) End If Next i With Sheet1 Darr = .Range(.[C5], .[C65500].End(xlUp)).Resize(, 9).Value End With For i = 1 To UBound(Darr, 1) Tem = Darr(i, 1) & Darr(i, 9) If Dic.exists(Tem) Then Darr(i, 1) = Dic.Item(Tem) Else Darr(i, 1) = IIf(Darr(i, 9) = "", Darr(i, 2), "") End If Next i With Sheet1 .[J5].Resize(i - 1) = Darr End With Set Dic = Nothing End Sub

Code gì mà ghê quá vậy bạn? Code của tôi chỉ thế này thôi:
[GPECODE=vb]Private Sub CommandButton1_Click()
Dim Cll As Range, Des As Range
On Error Resume Next
For Each Cll In [Q5:Q8]
Set Des = [C5:C21].Find(Cll, , , xlWhole).Offset(, 7)
If IsEmpty(Des) Then Des = Cll.Offset(, 2)
Next
End Sub[/GPECODE]

HocVBAExcel · 5/3/16

nghiaphuc đã viết:
Code gì mà ghê quá vậy bạn? Code của tôi chỉ thế này thôi:
[GPECODE=vb]Private Sub CommandButton1_Click()
Dim Cll As Range, Des As Range
On Error Resume Next
For Each Cll In [Q5:Q8]
Set Des = [C5:C21].Find(Cll, , , xlWhole).Offset(, 7)
If IsEmpty(Des) Then Des = Cll.Offset(, 2)
Next
End Sub[/GPECODE]

Ý mình nếu cột K mà trống thì mới lấy giá trị . còn code này cột K có giá trị thì vận lấy kết quả.
Đoạn code trên thực hiện lần đầu thì đúng kết quả mình mong muốn nhưng mình muốn chỉ cập nhật nhưng ô trống khi thay đổi vùng Q:S
Cám Ơn anh nhiều.

nghiaphuc · 5/3/16

HocVBAExcel đã viết:
Ý mình nếu cột K mà trống thì mới lấy giá trị . còn code này cột K có giá trị thì vận lấy kết quả.
Đoạn code trên thực hiện lần đầu thì đúng kết quả mình mong muốn nhưng mình muốn chỉ cập nhật nhưng ô trống khi thay đổi vùng Q:S
Cám Ơn anh nhiều.

Thế tóm lại là bạn muốn gán giá trị vào cột J hay cột K vậy? Ở bài trên thì nói cột J, bây giờ thì lại là cột K.

HocVBAExcel · 5/3/16

nghiaphuc đã viết:
Thế tóm lại là bạn muốn gán giá trị vào cột J hay cột K vậy? Ở bài trên thì nói cột J, bây giờ thì lại là cột K.

Lấy kết quả Cột J với điều kiện Cột K phải trống thì mới cập nhật dữ liệu.

Ba Tê · 5/3/16

HocVBAExcel đã viết:
Lấy kết quả Cột J với điều kiện Cột K phải trống thì mới cập nhật dữ liệu.

Vẫn còn bất cập, phải nói luôn cột K trống và cột J trống mới điền dữ liệu vào cột J ?
Muốn dùng Dic ?

HocVBAExcel · 5/3/16

Ba Tê đã viết:
Vẫn còn bất cập, phải nói luôn cột K trống và cột J trống mới điền dữ liệu vào cột J ?
Muốn dùng Dic ?

Máy em download không được anh chép code ra ngoài dùm em
Cám ơn anh nhiều.

Ba Tê · 5/3/16

HocVBAExcel đã viết:
Máy em download không được anh chép code ra ngoài dùm em
Cám ơn anh nhiều.

PHP:

Public Sub GPE()
Dim Dic As Object, sArr(), dArr(), I As Long
Set Dic = CreateObject("Scripting.Dictionary")
With Sheet1
sArr = .Range("Q5", .Range("S65536").End(xlUp)).Value
For I = 1 To UBound(sArr)
    Dic.Item(sArr(I, 1)) = sArr(I, 3)
Next I
sArr = .Range("C5", .Range("C65536").End(xlUp)).Resize(, 9).Value
dArr = .Range("C5", .Range("C65536").End(xlUp)).Offset(, 7).Value
For I = 1 To UBound(sArr)
    If Dic.Exists(sArr(I, 1)) Then
        If sArr(I, 9) = Empty Then
            If dArr(I, 1) = Empty Then
                dArr(I, 1) = Dic.Item(sArr(I, 1))
            End If
        End If
    End If
Next I
    .Range("J5").Resize(I - 1) = dArr
End With
Set Dic = Nothing
End Sub

Tôi copy Code lên GPE mấy lần mà cứ báo lỗi.

HocVBAExcel · 5/3/16

Ba Tê đã viết:

PHP:

Public Sub GPE()
Dim Dic As Object, sArr(), dArr(), I As Long
Set Dic = CreateObject("Scripting.Dictionary")
With Sheet1
sArr = .Range("Q5", .Range("S65536").End(xlUp)).Value
For I = 1 To UBound(sArr)
    Dic.Item(sArr(I, 1)) = sArr(I, 3)
Next I
sArr = .Range("C5", .Range("C65536").End(xlUp)).Resize(, 9).Value
dArr = .Range("C5", .Range("C65536").End(xlUp)).Offset(, 7).Value
For I = 1 To UBound(sArr)
    If Dic.Exists(sArr(I, 1)) Then
        If sArr(I, 9) = Empty Then
            If dArr(I, 1) = Empty Then
                dArr(I, 1) = Dic.Item(sArr(I, 1))
            End If
        End If
    End If
Next I
    .Range("J5").Resize(I - 1) = dArr
End With
Set Dic = Nothing
End Sub

Tôi copy Code lên GPE mấy lần mà cứ báo lỗi.

Mã:

Dim Dic As Object, sArr(), dArr(), I As Long
Set Dic = CreateObject("Scripting.Dictionary")
With Sheet1
sArr = .Range("Q5", .Range("S65536").End(xlUp)).Value
For I = 1 To UBound(sArr)
    Dic.Item(sArr(I, 1)) = sArr(I, 3)
Next I
sArr = .Range("C5", .Range("C65536").End(xlUp)).Resize(, 9).Value
dArr = .Range("C5", .Range("C65536").End(xlUp)).Offset(, 7).Value
For I = 1 To UBound(sArr)
    If Dic.Exists(sArr(I, 1)) Then
        If sArr(I, 9) = Empty Then
            If dArr(I, 1) = Empty Then
                dArr(I, 1) = Dic.Item(sArr(I, 1))
                 [COLOR=#ff0000]  else
                  dArr(I, 1) = sArr(I, 2) [/COLOR]
            End If
        End If
    End If
Next I
    .Range("J5").Resize(I - 1) = dArr
End With
Set Dic = Nothing
End Sub

Em muốn bổ sung thêm điều kiện nếu dò không có thì lấy cột D giống như code em đang áp dụng.

Ba Tê · 5/3/16

HocVBAExcel đã viết:
Em muốn bổ sung thêm điều kiện nếu dò không có thì lấy cột D giống như code em đang áp dụng.

Sửa đoạn này 1 chút

PHP:

....................
For I = 1 To UBound(sArr)
    If sArr(I, 9) = Empty Then
        If dArr(I, 1) = Empty Then
            If Dic.Exists(sArr(I, 1)) Then
                dArr(I, 1) = Dic.Item(sArr(I, 1))
            Else
                dArr(I, 1) = sArr(I, 2)
            End If
        End If
    End If
Next I
...................

Cập nhật dữ liệu vào những ô trống còn những ô có giá trị thì giữ nguyên (1 người xem)

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

HocVBAExcel

Thành viên mới

SA_DQ

/(hông là gì!

nghiaphuc

Thành viên gạo cội

HocVBAExcel

Thành viên mới

nghiaphuc

Thành viên gạo cội

HocVBAExcel

Thành viên mới

Ba Tê

Cạo Rồi Khỏi Gội

File đính kèm

HocVBAExcel

Thành viên mới

Ba Tê

Cạo Rồi Khỏi Gội

HocVBAExcel

Thành viên mới

Ba Tê

Cạo Rồi Khỏi Gội

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

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Đếm ngược thời gian