Các câu hỏi về lọc ra danh sách duy nhất (loại bỏ dữ liệu trùng) (4 người xem)

Liên hệ QC

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

Em cám ơn anh HieuCD nha !
Đơn giá xuất ở Sheet NXT em đã sửa lại như sau:
Đơn giá NXT = TT tồn đầu + TT nhập / M3 tồn đầu + M3 nhập
TT xuất = Đơn giá NXT * M3 xuất

1. Mình cập nhật đơn giá PN hay NK mua vào ở Sheet PS
2. Cập nhật Sheet NXT sẽ tính được đơn giá xuất kho hoặc xuất khác trong XNT (giải thích phía trên)
3. Cập nhật giá PX hay XK lấy từ Giá Sheet NXT.

Theo như anh mình thêm 1 cột phụ, hàm OFFSET(PS!$T$3,,,PS!$T$1) ý nghĩa là gì vậy anh?
Em chưa khai thác hết hàm này rồi, mong anh giải thích thêm cho em với.
Mình quy ước đặt mã kiện mã VT + mã cc + ngày để tiện quản lý, không cần cột phụ được không anh!

Anh xem giúp em như vậy có hợp lý chưa nhỉ ?
 
Lần chỉnh sửa cuối:
Em cám ơn anh HieuCD nha !
Đơn giá xuất ở Sheet NXT em đã sửa lại như sau:
Đơn giá NXT = TT tồn đầu + TT nhập / M3 tồn đầu + M3 nhập
TT xuất = Đơn giá NXT * M3 xuất

1. Mình cập nhật đơn giá PN hay NK mua vào ở Sheet PS
2. Cập nhật Sheet NXT sẽ tính được đơn giá xuất kho hoặc xuất khác trong XNT (giải thích phía trên)
3. Cập nhật giá PX hay XK lấy từ Giá Sheet NXT.

Theo như anh mình thêm 1 cột phụ, hàm OFFSET(PS!$T$3,,,PS!$T$1) ý nghĩa là gì vậy anh?
Em chưa khai thác hết hàm này rồi, mong anh giải thích thêm cho em với.
Mình quy ước đặt mã kiện mã VT + mã cc + ngày để tiện quản lý, không cần cột phụ được không anh!

Anh xem giúp em như vậy có hợp lý chưa nhỉ ?
Hàm Sumifs nặng hơn hàm Sumif nhiều, mình dùng cột phụ để gom các điều kiện vào 1 cột để dùng hàm Sumif cho đơn giản và nhẹ file
OFFSET(PS!$T$3,,,PS!$T$1) thay thế cho vùng dữ liệu: PS!$T$3:$T$1062 và khi dữ liệu thêm bớt dòng thì vùng dữ liệu tự tính lại
dữ liệu của bạn thiếu đơn giá nhập kho nên không làm gì được
 
Anh HieuCD !
- Nếu không có đơn giá thì Thành tiền mặc định = 1 hay 0 được không anh vì kho họ chỉ cần số lượng thôi.
- Thu mua họ mới cập nhật giá vào, Nhấn Sheet PS tự điền giá nhập vào có đc thành tiền.
- Nhấn lần nữa bên Sheet NXT sẽ có thành tiền và đơn giá xuất
- Tiếp tục cập nhật đơn giá xuất bên Sheet PS (có thể bỏ qua chỗ này).
Anh xem giúp em với ah, cám ơn anh nhiều !
Cty quy định như vậy rồi, em làm tay thì vẫn làm theo quy trình như vậy
 
Anh HieuCD !
- Nếu không có đơn giá thì Thành tiền mặc định = 1 hay 0 được không anh vì kho họ chỉ cần số lượng thôi.
- Thu mua họ mới cập nhật giá vào, Nhấn Sheet PS tự điền giá nhập vào có đc thành tiền.
- Nhấn lần nữa bên Sheet NXT sẽ có thành tiền và đơn giá xuất
- Tiếp tục cập nhật đơn giá xuất bên Sheet PS (có thể bỏ qua chỗ này).
Anh xem giúp em với ah, cám ơn anh nhiều !
Cty quy định như vậy rồi, em làm tay thì vẫn làm theo quy trình như vậy
Tạo sheet NXT
Mã:
Sub TaoNXT()
  Dim i As Long, j As Byte, k As Long, ik As Long, key As String, Test As Boolean
  Dim Dic As Object, Arr As Variant, dArr As Variant, Col As Variant, Tmp As Variant, S As Variant
  Set Dic = CreateObject("Scripting.Dictionary")
   
  i = Sheets("XNT").Range("A" & Rows.Count).End(xlUp).Row
  If i > 9 Then
    dArr = Sheets("XNT").Range("B10:W" & i).Value
    ReDim Arr(1 To UBound(dArr, 1), 1 To 18)
    Col = Array("", 5, 6, 7, 8, 9, 10, 14, 15, 16)
    For i = 1 To UBound(dArr, 1)
      If dArr(i, 1) <> "" And dArr(i, 2) <> "" Then
        Test = False
        For j = 1 To 9
          If dArr(i, Col(j)) > 0 Then Test = True: Exit For
        Next j
        If Test = True Then 'Kiem tra co du lieu moi lay
          key = dArr(i, 1)
          If Not Dic.exists(key) Then
            k = k + 1
            Dic.Add key, k
            For j = 1 To 3
              Arr(k, j) = dArr(i, j)
            Next j
            Tmp = Split(Arr(k, 1), " ")
            S = Split(LCase(Tmp(UBound(Tmp))), "x")
            If IsArray(S) Then
              For j = 0 To UBound(S)
                Arr(k, j + 4) = S(j)
              Next j
            End If
            For j = 1 To 9
              Arr(k, j + 6) = dArr(i, Col(j))
            Next j
          Else
            ik = Dic.Item(key)
            For j = 1 To 9
              Arr(ik, j + 6) = Arr(ik, j + 6) + dArr(i, Col(j))
            Next j
          End If
        End If
      End If
    Next i
  End If

  For i = 1 To k
    For j = 7 To 9
      Arr(i, j + 9) = Arr(i, j) + Arr(i, j + 3) - Arr(i, j + 6)
    Next j
  Next i
  With Sheets("NXT")
    Range("A10:R235").ClearContents
    Range("A10").Resize(k, 18) = Arr
  End With
  End Sub
 
Anh HieuCD ơi !

Anh viết nhầm qua Sheet NXT rồi, hix - sheet này là e tự làm bằng tay thôi
Anh chỉnh lại dùm em là Sheet XNT mới đúng nha anh.
Làm phiền anh nhiều quá cũng ngại.
Anh có cần em hỗ trợ gì, trong khả năng của em thì em sẽ nhất định hỗ trợ hết mình để giúp anh.

Em cám ơn anh!
 
Anh HieuCD ơi !

Anh viết nhầm qua Sheet NXT rồi, hix - sheet này là e tự làm bằng tay thôi
Anh chỉnh lại dùm em là Sheet XNT mới đúng nha anh.
Làm phiền anh nhiều quá cũng ngại.
Anh có cần em hỗ trợ gì, trong khả năng của em thì em sẽ nhất định hỗ trợ hết mình để giúp anh.

Em cám ơn anh!
Sheet XNT làm rồi mà, bạn muốn như thế nào?
 
Anh Hieu CD !
Lần đầu và lần thứ 2 nhảy cùng 1 giá trị, lần 3 nhảy khác.
Cả 3 lần đầu sai ở khoảng 10 dòng đầu không đúng theo các trường Mã kiện + mã vật tư + tên vt + đvt + đơn giá...
Mong anh kiểm tra lại giúp em với ah.
Tự động xóa những dòng khác đi luôn đi a thay vì như hôm trước em nhờ a lọc mã trùng, ẩn những dòng trống
những cột kia e dùng công thức excel. Em cám ơn anh nhiều !
 
Lần chỉnh sửa cuối:
Anh HieuCD ơi !

Anh cố gắng giúp dùm em hoàn thành mấy sheet với anh !
Sheet Phiếu nhập kho + phiếu xuất kho + Sổ chi tiết nguyên liệu + Công nợ + Sổ chi tiết công nợ.
(Excel thì em đã chèn sẵn công thức hêt rồi)

Em cám ơn anh nhiều lắm !
 
Lần chỉnh sửa cuối:
Anh HieuCD ơi !

Anh cố gắng giúp dùm em hoàn thành mấy sheet với anh !
Sheet Phiếu nhập kho + phiếu xuất kho + Sổ chi tiết nguyên liệu + Sổ chi tiết công nợ.
(Excel thì em đã chèn sẵn công thức hêt rồi)

Em cám ơn anh nhiều lắm !
Dùng công thức chạy vèo vèo là tốt rồi, bạn muốn mình làm gì?
 
Nhờ Anh viết code dùm em ở mấy Sheet dưới:
Phiếu nhập kho + phiếu xuất kho + Sổ chi tiết nguyên liệu + Công nợ + Sổ chi tiết công nợ.
Vì số lượng thực tế lên tới 6.000 dòng. Công thức tạo các liên kết, không như Code VBA tính rồi, dán giá trị tuyệt đối rất là nhẹ file.
Code Sheet XNT của a bị lỗi, em dùng hàm để liên kết.
Em rất rất cám ơn nhiều!
 

File đính kèm

Lần chỉnh sửa cuối:
Kính chào các Anh Chị diễn đàn !
Em nhờ các Anh Chị viết giúp Em VBA theo một số yêu cầu như sau:
- So sánh trên nhiều sheet "VD: Sheet2 và 3" và lọc ra các giá trị không trùng nhau.
- Tổng hợp về sheet1 gồm tên sheet, địa chỉ và các giá trị không trùng nhau đó như file đính kèm.
Cám ơn các Anh Chị !
 

File đính kèm

Kính chào các Anh Chị diễn đàn !
Em nhờ các Anh Chị viết giúp Em VBA theo một số yêu cầu như sau:
- So sánh trên nhiều sheet "VD: Sheet2 và 3" và lọc ra các giá trị không trùng nhau.
- Tổng hợp về sheet1 gồm tên sheet, địa chỉ và các giá trị không trùng nhau đó như file đính kèm.
Cám ơn các Anh Chị !
Up đã lâu mà không ai giúp mình vậy ta.
 
Kính chào các Anh Chị diễn đàn !
Em nhờ các Anh Chị viết giúp Em VBA theo một số yêu cầu như sau:
- So sánh trên nhiều sheet "VD: Sheet2 và 3" và lọc ra các giá trị không trùng nhau.
- Tổng hợp về sheet1 gồm tên sheet, địa chỉ và các giá trị không trùng nhau đó như file đính kèm.
Cám ơn các Anh Chị !
Chạy đoạn code này xem sao
Mã:
Public Sub ThanhThat()
Dim Wsh As Worksheet
Dim Res
Dim Cll As Range
Dim i

With CreateObject("Scripting.Dictionary")
For Each Wsh In Worksheets
    If Wsh.Name <> "Sheet1" Then
        For Each Cll In Wsh.UsedRange
            If Cll.Value <> "" Then
                If .exists(Cll.Value) = False Then
                    .Add Cll.Value, Array(Cll.Address, Wsh.Name, 1)
                Else
                    Tmp = .Item(Cll.Value)
                    Tmp(2) = Tmp(2) + 1
                    .Item(Cll.Value) = Tmp
                End If
            End If
        Next Cll
    End If
Next Wsh
For Each i In .keys
    If .Item(i)(2) > 1 Then .Remove i
Next i

ReDim Res(1 To .Count, 1 To 3)
For i = 0 To .Count - 1
    Res(i + 1, 1) = .items()(i)(1)
    Res(i + 1, 2) = .items()(i)(0)
    Res(i + 1, 3) = .keys()(i)
Next i
End With

With Sheet1
.Range("A2", .Range("C" & .Range("A2").End(xlDown).Row)).ClearContents
.Range("A2").Resize(UBound(Res), UBound(Res, 2)) = Res
End With
End Sub
 
Lần chỉnh sửa cuối:
Chạy đoạn code này xem sao
Mã:
Public Sub ThanhThat()
Dim Wsh As Worksheet
Dim Res
Dim Cll As Range
Dim i
With CreateObject("Scripting.Dictionary")
For Each Wsh In Worksheets
    If Wsh.Name <> "Sheet1" Then
        For Each Cll In Wsh.UsedRange
            If Cll.Value <> "" Then
                If .exists(Cll.Value) = False Then
                    .Add Cll.Value, Array(Cll.Address, Wsh.Name)
                Else
                    .Remove Cll.Value
                End If
            End If
        Next Cll
    End If
Next Wsh
ReDim Res(1 To .Count, 1 To 3)
For i = 0 To .Count - 1
    Res(i + 1, 1) = .items()(i)(1)
    Res(i + 1, 2) = .items()(i)(0)
    Res(i + 1, 3) = .keys()(i)
Next i
End With
With Sheet1
.Range("A2", .Range("C" & .Range("A2").End(xlDown).Row)).ClearContents
.Range("A2").Resize(UBound(Res), UBound(Res, 2)) = Res
End With
End Sub
.Remove Cll.Value chỗ này chắc đúng không bạn?
 
Chạy đoạn code này xem sao
Mã:
Public Sub ThanhThat()
Dim Wsh As Worksheet
Dim Res
Dim Cll As Range
Dim i

With CreateObject("Scripting.Dictionary")
For Each Wsh In Worksheets
    If Wsh.Name <> "Sheet1" Then
        For Each Cll In Wsh.UsedRange
            If Cll.Value <> "" Then
                If .exists(Cll.Value) = False Then
                    .Add Cll.Value, Array(Cll.Address, Wsh.Name, 1)
                Else
                    Tmp = .Item(Cll.Value)
                    Tmp(2) = Tmp(2) + 1
                    .Item(Cll.Value) = Tmp
                End If
            End If
        Next Cll
    End If
Next Wsh
For Each i In .keys
    If .Item(i)(2) > 1 Then .Remove i
Next i

ReDim Res(1 To .Count, 1 To 3)
For i = 0 To .Count - 1
    Res(i + 1, 1) = .items()(i)(1)
    Res(i + 1, 2) = .items()(i)(0)
    Res(i + 1, 3) = .keys()(i)
Next i
End With

With Sheet1
.Range("A2", .Range("C" & .Range("A2").End(xlDown).Row)).ClearContents
.Range("A2").Resize(UBound(Res), UBound(Res, 2)) = Res
End With
End Sub
Để mình kiểm tra xem đã nhé, Cám ơn Bạn nhiều !
 
Chạy đoạn code này xem sao
Mã:
Public Sub ThanhThat()
Dim Wsh As Worksheet
Dim Res
Dim Cll As Range
Dim i

With CreateObject("Scripting.Dictionary")
For Each Wsh In Worksheets
    If Wsh.Name <> "Sheet1" Then
        For Each Cll In Wsh.UsedRange
            If Cll.Value <> "" Then
                If .exists(Cll.Value) = False Then
                    .Add Cll.Value, Array(Cll.Address, Wsh.Name, 1)
                Else
                    Tmp = .Item(Cll.Value)
                    Tmp(2) = Tmp(2) + 1
                    .Item(Cll.Value) = Tmp
                End If
            End If
        Next Cll
    End If
Next Wsh
For Each i In .keys
    If .Item(i)(2) > 1 Then .Remove i
Next i

ReDim Res(1 To .Count, 1 To 3)
For i = 0 To .Count - 1
    Res(i + 1, 1) = .items()(i)(1)
    Res(i + 1, 2) = .items()(i)(0)
    Res(i + 1, 3) = .keys()(i)
Next i
End With

With Sheet1
.Range("A2", .Range("C" & .Range("A2").End(xlDown).Row)).ClearContents
.Range("A2").Resize(UBound(Res), UBound(Res, 2)) = Res
End With
End Sub
Bạn giúp lại mình với ! Code chỉ tìm trên một cột bất kỳ của các sheet nhập vào từ bàn phím.
Thanks !!
 
Lần chỉnh sửa cuối:
Web KT

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

Back
Top Bottom