Cập nhật dữ liệu từ sheet này sang sheet khác (1 người xem)

Liên hệ QC

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

peter2012

Thành viên mới
Tham gia
15/1/13
Bài viết
2
Được thích
0
Các anh trong Forum chuyên gia VB giúp em với. Em ko rành món này lắm, sẵn cv nên tìm hiểu luôn nhưng thấy cũng hơi mới. Hy vọng có cao thủ giúp đỡ.
Em cần cập nhật thông tin từ Sheet 1 sang Sheet 2. Ở Sheet 1: có 9 mã , mỗi lần cập nhật thông tin của mã nào ví dụ mã 1AA, thì cập nhật vào B2,C2,D2. Thì ở Sheet 2, sẽ lấy thông tin của C2,D2 đền vào dòng tiếp theo. Theo vd là điền vào Sheet 2 là:
Sheet2!A11= "1AA"
Sheet2!B11= Sheet1!C2
Sheet2!D11= Sheet1!D2

Tức chỉ thay đổi ở Sheet 1 cột C,D thì Sheet 2 tự cập nhật các dòng tiếp theo.

Nhờ các cao thủ giúp sớm jùm em. Em cám ơn nhiều
 

File đính kèm

Chỉnh sửa lần cuối bởi điều hành viên:
Các anh trong Forum chuyên gia VB giúp em với. Em ko rành món này lắm, sẵn cv nên tìm hiểu luôn nhưng thấy cũng hơi mới. Hy vọng có cao thủ giúp đỡ.
Em cần cập nhật thông tin từ Sheet 1 sang Sheet 2. Ở Sheet 1: có 9 mã , mỗi lần cập nhật thông tin của mã nào ví dụ mã 1AA, thì cập nhật vào B2,C2,D2. Thì ở Sheet 2, sẽ lấy thông tin của C2,D2 đền vào dòng tiếp theo. Theo vd là điền vào Sheet 2: A11= 1AA, B11=C2, D11=D2.
Tức chỉ thay đổi ở Sheet 1 cột C,D thì Sheet 2 tự cập nhật các dòng tiếp theo.

Nhờ các cao thủ giúp sớm jùm em. Em cám ơn nhiều

Với bài của bạn cũng khá vất vã khi update tiếp thông tin lại vướng số thứ tự của mỗi thông tin, buộc lòng tôi phải viết thêm 1 hàm đếm ký tự trong chuỗi!

Hàm đếm ký tự CharCount:

[gpecode=vb]Function CharCount(ByVal txtString As String, ByVal txtChr As String) As Long
Dim f As Long, l As Long, n As Long
txtString = Trim(txtString)
l = Len(txtChr) - 1
f = InStr(1, txtString, txtChr, vbTextCompare) + l
If f > 0 Then
Do Until f = l
n = n + 1
txtString = Replace(txtString, Left(txtString, f), "", , 1)
f = InStr(1, txtString, txtChr, vbTextCompare) + l
Loop
CharCount = n
End If
End Function[/gpecode]

Sau đó tôi bắt đầu viết tiếp thủ tục cập nhật thông tin từ sheet2:

Mã:
Sub InfoUpdate()

      On Error Resume Next
      
      With Application
      
            .ScreenUpdating = False
            .EnableEvents = False
            .Calculation = xlCalculationManual
      
            Dim InfoArr As Variant, UpdateArr As Variant
            Dim newDate  As Date, oldDate As Date
            Dim Upd As Long, Inf As Long, i As Long, n As Long, u As Long
            
            UpdateArr = Range(Sheet1.[A2], Sheet1.[A65536].End(xlUp)).Resize(, 4).Value
            InfoArr = Range(Sheet2.[A2], Sheet2.[A65536].End(xlUp)).Resize(, 3).Value
            
            Upd = UBound(UpdateArr)
            Inf = UBound(InfoArr)
            
            For u = 1 To Upd
                  oldDate = UpdateArr(u, 3): n = 0
                  For i = 1 To Inf
                        newDate = InfoArr(i, 2)
                        If InfoArr(i, 1) = UpdateArr(u, 1) And newDate > oldDate Then
                                    If UpdateArr(u, 2) = "" Then
                                    UpdateArr(u, 2) = "1." & Chr(160) & InfoArr(i, 3)
                              Else
                                    n = 1 + CharCount(UpdateArr(u, 2), "." & Chr(160))
                                    UpdateArr(u, 2) = UpdateArr(u, 2) & vbLf & n & "." & Chr(160) & InfoArr(i, 3)
                              End If
                              
                              UpdateArr(u, 3) = newDate
                              UpdateArr(u, 4) = InfoArr(i, 3)
                        End If
                  Next
            Next
            
            Sheet1.[A2].Resize(Upd, 4).Value = UpdateArr

            .Calculation = xlCalculationAutomatic
            .EnableEvents = True
            .ScreenUpdating = True
      End With
      
End Sub

Làm một bài mà tư duy toát cả mồ hôi!

Để "nhận dạng" khi đếm ký tự và tránh nhầm lẫn với các ký tự khoảng trắng, tôi đã dùng khoảng trắng kiểu Chr(160) thay cho khoảng trắng gõ bằng thanh space, như vậy thì hạn chế thấp nhất việc đếm nhầm.

Bạn xem file thử đúng ý bạn chưa nhé!
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Nếu cột C ở Sheet 1 tự động cập nhật ngày và sau đó cập nhật ngày hiện tại luôn vào cột B ở Sheet 2 tương ứng dữ liệu mới thì sao anh nhapmon nhỉ? em có nhập thử nhiều lần nhưng có khi cột ngày cập nhật ở Sheet 2 ko cập nhật lại cột C ở Sheet 1
 
Upvote 0
Nếu cột C ở Sheet 1 tự động cập nhật ngày và sau đó cập nhật ngày hiện tại luôn vào cột B ở Sheet 2 tương ứng dữ liệu mới thì sao anh nhapmon nhỉ? em có nhập thử nhiều lần nhưng có khi cột ngày cập nhật ở Sheet 2 ko cập nhật lại cột C ở Sheet 1


mình không thực sự hiểu ý bạn lắm. có phải bạn muốn khi có bất kỳ thay đổi nào ở cột C và D ở sheet 1 thì cập nhật vào sheet 2. có phải vậy không?
 

File đính kèm

Upvote 0
Web KT

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

Back
Top Bottom