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

[nmhung49]

- Thứ nhất: Chỉ 1 vòng lập là được rồi
- Thứ hai: Nguyên tắc xử lý dữ liệu là nên cố gắng thu gom cùng 1 loại dữ liệu, tức chỉ nên Add ngày tháng vào Dictionary, đừng nên lẫn lộn chuổi (tiêu đề) ---> Sẽ khiến cho ta khó khăn trong việc xử lý ---> Tiêu đề có thể đặt ở phần cuối code cũng đâu có vấn đề gì

Sáng làm gấp quá không để ý 1 vòng lặp là được rồi, vì em thấy dữ liệu đơn giản nên làm cho đơn giản nên không có phân ra. Nếu dùng 1 vòng lặp em làm cách này không biết có cách nào hay hơn vì dữ liệu nằm ở các sheet không dùng cột

[GPECODE=vb]
Sub DicOnly1()
Dim Dic As Object, shArr, sh, srange, i As Long
Set Dic = CreateObject("Scripting.Dictionary")
shArr = Array("Sheet1", "Sheet2")
For Each sh In shArr
If sh = "Sheet1" Then
srange = Sheets(sh).Range("A4:A" & Sheets(sh).Range("A14").End(xlDown).Row).Value
Else
srange = Sheets(sh).Range("C9:C" & Sheets(sh).Range("C9").End(xlDown).Row).Value
End If

For i = 1 To UBound(srange)
If Not Dic.Exists(srange(i, 1)) Then
Dic.Add srange(i, 1), ""
End If
Next i

Next
If Dic.Count Then Sheets("sheet4").Range("A1").Resize(Dic.Count, 1).Value = Application.Transpose(Dic.Keys)


End Sub


[/GPECODE]

Nếu dữ liệu ở nhiều sheet mà nằm rời rạc vậy mình có cách nào gom vào mảng nguồn để xử lý trong Dic không anh

 

[ndu96081631]

Nếu dữ liệu ở nhiều sheet mà nằm rời rạc vậy mình có cách nào gom vào mảng nguồn để xử lý trong Dic không anh

Nếu chẳng có quy luật gì thì cũng đành làm từng phần thế thôi
Lưu ý như tôi đã nói ở trên: Không lên gom tiêu đề vào trong Dic nhé (lẫn lộn với dữ liệu dạng Date) ---> Nói chung là không nên làm thế

 

[langtham113]

Các bạn giúp mình sort lại dữ liệu trước hoặc sau khi gán ra sheet luôn với.
Thầy NDU "Lưu ý như tôi đã nói ở trên: Không lên gom tiêu đề vào trong Dic nhé (lẫn lộn với dữ liệu dạng Date) ---> Nói chung là không nên làm thế"
Em đọc đi đọc lại mà không hiểu, Thầy có thể sửa lại code trên của bạn nmhung49 như thế nào cho hợp lý cho em với.

 

[duyenha855]

Bạn có thể nói rõ hơn không. Mình chưa hiểu "Ở cột B bạn chọn lọc non blank là ra danh sách giá trị duy nhất của cột A như bạn muốn"

 

[duyenha855]

Mình có nhiều sheet chứa dữ liệu của khách hàng và có số chứng minh thư của từng người, mình muốn tìm ra các khách hàng trùng nhau (có thể ở cùng 1 sheet hoặc ở khác sheet) thì làm như nào?

 

[ngocna]

Mình có dữ liệu nhập hàng mỗi ngày, cuối tháng mình muốn cộng tổng từng loại hàng mua, nếu mặt hàng có có 2 đơn giá thì sẽ thành 2 dòng, các bạn xem file đính kèm giúp mình với nhé.
View attachment Book1.xlsx

 

[thomthom]

Bạn chọn cả cột có dữ liệu trùng.
Nếu bạn dùng Excel 2007. Bạn vào Data => Remove Duplicate: Nó sẽ bỏ ra những dữ liệu trùng cho bạn.

 

[Ba Tê]

Mình có dữ liệu nhập hàng mỗi ngày, cuối tháng mình muốn cộng tổng từng loại hàng mua, nếu mặt hàng có có 2 đơn giá thì sẽ thành 2 dòng, các bạn xem file đính kèm giúp mình với nhé.
View attachment 121984

Viết tặng 1 Sub cho file này, chỉ dùng trong 1 tháng:
[GPECODE=vb]Public Sub ThongKe()
Dim Dic As Object, sArr(), dArr(), I As Long, J As Long, K As Long, Tem As String
Set Dic = CreateObject("Scripting.Dictionary")
sArr = Range([C4], [C4].End(xlDown)).Resize(, 4).Value
ReDim dArr(1 To UBound(sArr, 1), 1 To 4)
For I = 1 To UBound(sArr, 1)
Tem = sArr(I, 1) & sArr(I, 3)
If Not Dic.Exists(Tem) Then
K = K + 1
Dic.Add Tem, K
For J = 1 To 4
dArr(K, J) = sArr(I, J)
Next J
Else
dArr(Dic.Item(Tem), 2) = dArr(Dic.Item(Tem), 2) + sArr(I, 2)
dArr(Dic.Item(Tem), 4) = dArr(Dic.Item(Tem), 4) + sArr(I, 4)
End If
Next I
[H8].Resize(K, 4) = dArr
[H8].Resize(K, 4).Sort Key1:=[H8], Key2:=[J8]
Set Dic = Nothing
End Sub[/GPECODE]

 

[huylt]

Hi all!
Nhờ các bác chỉ giúp công thức lọc, liệt kê những nhân viên tùy chọn theo thời gian với.
Lọc ra và liệt kê những giá trị B, C, D ở sheet Report.

 

[ngocdung1286]

các cao thủ giúp em với !thanks cả nhà. mật khẩu la 1 ạ.

 

[ba_caychuoi]

Các anh các chị giúp em với. Công việc hiện tại của em là nhập danh sách ô tô bảo hiểm, mỗi tháng em cho vào một Sheet riêng biệt, cuối tháng em phải kiểm tra xem có nhập trùng xe nào không.
Số liệu khá đơn giản, chỉ gồm biển số xe VD: 88A-06888, 30H-2500
Cho em hỏi có cách nào để nhập vào là em biết xe ấy em đã nhập rồi không, nếu tô màu được thì càng tốt ạ (mỗi tháng em phải nhập hàng trăm xe và dò mất cả ngày ạ). Mong anh chị giúp đỡ

 

[khuongvietphong]

Các anh các chị giúp em với. Công việc hiện tại của em là nhập danh sách ô tô bảo hiểm, mỗi tháng em cho vào một Sheet riêng biệt, cuối tháng em phải kiểm tra xem có nhập trùng xe nào không.
Số liệu khá đơn giản, chỉ gồm biển số xe VD: 88A-06888, 30H-2500
Cho em hỏi có cách nào để nhập vào là em biết xe ấy em đã nhập rồi không, nếu tô màu được thì càng tốt ạ (mỗi tháng em phải nhập hàng trăm xe và dò mất cả ngày ạ). Mong anh chị giúp đỡ

Bạn thử File này coi đúng ý không nha

 

[iamnobika]

Bạn thử File này coi đúng ý không nha

Bạn ơi, cách làm như nào vậy, có thể hướng dẫn mình được không?
^^!

 

[n0thing1988]

Bạn ơi, cách làm như nào vậy, có thể hướng dẫn mình được không?
^^!

Ấn vào Conditional Formatting để xem công thức. Và gõ từ khóa Conditional Formatting để tìm hiểu nhé

 

[gachbi2004]

Em chi muốn tạo danh sách không trùng nhau o cột A sheet1 thì sửa lại như nào vậy anh, của anh la lọc ra cả một bảng dữ liệu

 

[gachbi2004]

Sao không dùng Advanced Filter cho gọn nhỉ?

Sub LocTrung()
  Dim Rng As Range
  [A1].CurrentRegion.Clear
  Set Rng = Sheet1.[A1].CurrentRegion
  Rng.AdvancedFilter Action:=2, CopyToRange:=[A1], Unique:=True
End Sub

Em chi muốn tạo danh sách không trùng nhau o cột A sheet1 thì sửa lại như nào vậy anh, của anh la lọc ra cả một bảng dữ liệu

 

[gachbi2004]

xem thử file này ---> Mở file nhớ Enable macro nhé
Muốn công thức thì tham khảo tại đây:
http://www.giaiphapexcel.com/forum/showthread.php?t=12035

Anh ơi chỉnh code giup em nó tự động chạy ah, vi em xóa đi thì nó không chạy, thêm số liệu vào cột thì nó mới chạy ah. Em cam ơn

 

[foxconny]

Dear all.

Mình có 3 kho hàng, hàng ngày xuất cho nhiều khách, mỗi khách 1 vài mã hàng.
Mình muốn kiểm tra xem 1 kho 1 ngày xuất ra bao nhiêu mã hàng hóa, và số lượng bao nhiêu thì thiết lập như thế nào các bạn nhỉ? Nhờ mọi người giúp mình nhé.
Cảm ơn

 

[dinhduy]

Chào cả nhà !

Em có 1 vấn đề, rất mong được sự giúp đỡ của mọi người ah. Cám ơn !

Em nhập dữ liệu từ sheet PS
- Sheet XNT em lọc ra dữ liệu duy nhất và ẩn dòng trống từ sheet PS gồm có 4 trường:
+ Mã kiện
+ Mã hàng
+ Tên hàng
+ ĐVT
- Sheet CN em lọc ra duy nhất và ẩn dòng trống từ sheet PS gồm có 2 trường:
+ Mã khách hàng
+ Tên khách hàng

VD: Dữ liệu lọc từ dòng số 6 -> 500, có thể thực tế lọc ra chỉ được có 400 dòng thì 100 kia sẽ ẩn đi.
Vì bên dưới em chèn thêm mấy dòng dữ liệu, ngày tháng, người lập...

 

[HieuCD]

Chào cả nhà !

Em có 1 vấn đề, rất mong được sự giúp đỡ của mọi người ah. Cám ơn !

Em nhập dữ liệu từ sheet PS
- Sheet XNT em lọc ra dữ liệu duy nhất và ẩn dòng trống từ sheet PS gồm có 4 trường:
+ Mã kiện
+ Mã hàng
+ Tên hàng
+ ĐVT
- Sheet CN em lọc ra duy nhất và ẩn dòng trống từ sheet PS gồm có 2 trường:
+ Mã khách hàng
+ Tên khách hàng

VD: Dữ liệu lọc từ dòng số 6 -> 500, có thể thực tế lọc ra chỉ được có 400 dòng thì 100 kia sẽ ẩn đi.
Vì bên dưới em chèn thêm mấy dòng dữ liệu, ngày tháng, người lập...

chạy code

Sub XNT()
  Dim i As Long, k As Long, key As String
  Dim Arr As Variant, dArr As Variant
  With Sheets("PS")
    dArr = .Range("E3", .Range("H" & Rows.Count).End(xlUp)).Value
  End With
  ReDim Arr(1 To UBound(dArr, 1), 1 To 4)
  With CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(dArr, 1)
      key = dArr(i, 1) & "#" & dArr(i, 2)
      If Not .Exists(key) Then
        .Add key, ""
        k = k + 1
        Arr(k, 1) = dArr(i, 1): Arr(k, 2) = dArr(i, 2)
        Arr(k, 3) = dArr(i, 3): Arr(k, 4) = dArr(i, 4)
      End If
    Next i
  End With
  With Sheets("XNT")
    .Range("A7:D1007").EntireRow.Hidden = False
    .Range("A7:D1007").ClearContents
    If k Then .Range("A7:D7").Resize(k) = Arr
    i = .Range("A" & Rows.Count).End(xlUp).Row
    If i < 7 Then i = 7
    .Range("A" & i + 1, "A1007").EntireRow.Hidden = True
  End With
End Sub

Sub CN()
  Dim i As Long, k As Long, key As String
  Dim Arr, dArr
  With Sheets("PS")
    dArr = .Range("A3", .Range("B" & Rows.Count).End(xlUp)).Value
  End With
  ReDim Arr(1 To UBound(dArr, 1), 1 To 2)
  With CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(dArr, 1)
      key = dArr(i, 1)
      If Not .Exists(key) Then
        .Add key, ""
        k = k + 1
        Arr(k, 1) = dArr(i, 1): Arr(k, 2) = dArr(i, 2)
      End If
    Next i
  End With
  With Sheets("CN")
    .Range("A8:B47").EntireRow.Hidden = False
    .Range("A8:B47").ClearContents
    If k Then .Range("A8:B8").Resize(k) = Arr
    i = .Range("A" & Rows.Count).End(xlUp).Row
    If i < 8 Then i = 8
    .Range("A" & i + 1, "A47").EntireRow.Hidden = True
  End With
End Sub

 

[dinhduy]

Em cám ơn anh HieuCD nhiều nhiều nha.
Em làm được rồi !

 

[dinhduy]

Anh HieuCD ơi !

Nhờ Anh hỗ trợ dùm em 1 vấn đề này nữa, cụ thể như sau:
- Sheet PS - cột đơn giá dựa vào 2 điều kiện sẽ dò từ:
+ Sheet GIA: dựa vào 2 điều kiện mã hàng + mã nhà cũng cấp
+ Nếu không có sẽ dò Sheet XNT: dựa vào 2 điều kiện mã kiện + mã vật tư

Em cám ơn anh rất nhiều !

 

[HieuCD]

Anh HieuCD ơi !

Nhờ Anh hỗ trợ dùm em 1 vấn đề này nữa, cụ thể như sau:
- Sheet PS - cột đơn giá dựa vào 2 điều kiện sẽ dò từ:
+ Sheet GIA: dựa vào 2 điều kiện mã hàng + mã nhà cũng cấp
+ Nếu không có sẽ dò Sheet XNT: dựa vào 2 điều kiện mã kiện + mã vật tư

Em cám ơn anh rất nhiều !

Dữ liệu thay đổi dòng cột thì code phải viết lại

Sub GiaPS()
  Dim i As Long, key As String
  Dim Arr As Variant, dArr As Variant
With CreateObject("Scripting.Dictionary")
  With Sheets("GIA")
    i = .Range("A" & Rows.Count).End(xlUp).Row
    If i > 1 Then
      dArr = .Range("A2:E" & i).Value
      For i = 1 To UBound(dArr, 1)
        If dArr(i, 1) <> "" And dArr(i, 3) <> "" Then
          key = dArr(i, 1) & "#" & dArr(i, 3)
          .Item(key) = dArr(i, 5)
        End If
      Next i
    End If
  End With
 
  With Sheets("XNT")
    i = .Range("A" & Rows.Count).End(xlUp).Row
    If i > 9 Then
      dArr = .Range("A10:H" & i).Value
      For i = 1 To UBound(dArr, 1)
        If dArr(i, 1) <> "" And dArr(i, 2) <> "" Then
          key = dArr(i, 1) & "$" & dArr(i, 2)
          .Item(key) = dArr(i, 8)
        End If
      Next i
    End If
  End With
 
  With Sheets("PS")
    i = .Range("A" & Rows.Count).End(xlUp).Row
    If i > 2 Then
      dArr = .Range("A3:G" & i).Value
      ReDim Arr(1 To UBound(dArr, 1), 1 To 1)
      For i = 1 To UBound(dArr, 1)
        If dArr(i, 1) <> "" And dArr(i, 7) <> "" Then
          key = dArr(i, 1) & "#" & dArr(i, 7)
          If .exists(key) Then Arr(i, 1) = .Item(key)
        End If
        If Arr(i, 1) = "" Then
          If dArr(i, 6) <> "" And dArr(i, 7) <> "" Then
            key = dArr(i, 6) & "$" & dArr(i, 7)
            If .exists(key) Then Arr(i, 1) = .Item(key)
          End If
        End If
      Next i
    End If
    If IsArray(Arr) Then .Range("M3").Resize(UBound(Arr)) = Arr
  End With
End With
End Sub

Sub XNT()
  Dim i As Long, k As Long, key As String
  Dim Arr As Variant, dArr As Variant
  With Sheets("PS")
    dArr = .Range("F3", .Range("I" & Rows.Count).End(xlUp)).Value
  End With
  ReDim Arr(1 To UBound(dArr, 1), 1 To 4)
  With CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(dArr, 1)
      key = dArr(i, 1) & "#" & dArr(i, 2)
      If Not .exists(key) Then
        .Add key, ""
        k = k + 1
        Arr(k, 1) = dArr(i, 1): Arr(k, 2) = dArr(i, 2)
        Arr(k, 3) = dArr(i, 3): Arr(k, 4) = dArr(i, 4)
      End If
    Next i
  End With
  With Sheets("XNT")
    .Range("A10:D1010").EntireRow.Hidden = False
    .Range("A10:D1010").ClearContents
    If k Then .Range("A10:D10").Resize(k) = Arr
    i = .Range("A" & Rows.Count).End(xlUp).Row
    If i < 9 Then i = 9
    .Range("A" & i + 1, "A1010").EntireRow.Hidden = True
  End With
End Sub

Sub CN()
  Dim i As Long, k As Long, key As String
  Dim Arr, dArr
  With Sheets("PS")
    dArr = .Range("A3", .Range("B" & Rows.Count).End(xlUp)).Value
  End With
  ReDim Arr(1 To UBound(dArr, 1), 1 To 2)
  With CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(dArr, 1)
      key = dArr(i, 1)
      If Not .exists(key) Then
        .Add key, ""
        k = k + 1
        Arr(k, 1) = dArr(i, 1): Arr(k, 2) = dArr(i, 2)
      End If
    Next i
  End With
  With Sheets("CN")
    .Range("A10:B50").EntireRow.Hidden = False
    .Range("A10:B50").ClearContents
    If k Then .Range("A10:B10").Resize(k) = Arr
    i = .Range("A" & Rows.Count).End(xlUp).Row
    If i < 9 Then i = 9
    .Range("A" & i + 1, "A50").EntireRow.Hidden = True
  End With
End Sub

 

[dinhduy]

Dạ !
Em cám ơn anh HieuCD nhiều lắm ah!
Giúp đc em không ít.

 

[dinhduy]

Anh HieuCD xem lại giúp em với ah!
Báo lỗi chỗ dò đơn giá, nhờ anh xem lại giúp em với.
Em cám ơn nhiều !

 

[HieuCD]

Anh HieuCD xem lại giúp em với ah!
Báo lỗi chỗ dò đơn giá, nhờ anh xem lại giúp em với.
Em cám ơn nhiều !

2 with lồng nhau nó không chịu chạy

Sub GiaPS()
  Dim i As Long, key As String
  Dim Dic As Object, Arr As Variant, dArr As Variant
  Set Dic = CreateObject("Scripting.Dictionary")
  With Sheets("GIA")
    i = .Range("A" & Rows.Count).End(xlUp).Row
    If i > 1 Then
      dArr = .Range("A2:E" & i).Value
      For i = 1 To UBound(dArr, 1)
        If dArr(i, 1) <> "" And dArr(i, 3) <> "" Then
          key = dArr(i, 1) & "#" & dArr(i, 3)
          Dic.Item(key) = dArr(i, 5)
        End If
      Next i
    End If
  End With

  With Sheets("XNT")
    i = .Range("A" & Rows.Count).End(xlUp).Row
    If i > 9 Then
      dArr = .Range("A10:H" & i).Value
      For i = 1 To UBound(dArr, 1)
        If dArr(i, 1) <> "" And dArr(i, 2) <> "" Then
          key = dArr(i, 1) & "$" & dArr(i, 2)
          Dic.Item(key) = dArr(i, 8)
        End If
      Next i
    End If
  End With

  With Sheets("PS")
    i = .Range("A" & Rows.Count).End(xlUp).Row
    If i > 2 Then
      dArr = .Range("A3:G" & i).Value
      ReDim Arr(1 To UBound(dArr, 1), 1 To 1)
      For i = 1 To UBound(dArr, 1)
        If dArr(i, 1) <> "" And dArr(i, 7) <> "" Then
          key = dArr(i, 1) & "#" & dArr(i, 7)
          If Dic.exists(key) Then Arr(i, 1) = Dic.Item(key)
        End If
        If Arr(i, 1) = "" Then
          If dArr(i, 6) <> "" And dArr(i, 7) <> "" Then
            key = dArr(i, 6) & "$" & dArr(i, 7)
            If Dic.exists(key) Then Arr(i, 1) = Dic.Item(key)
          End If
        End If
      Next i
    End If
    If IsArray(Arr) Then .Range("M3").Resize(UBound(Arr)) = Arr
  End With
End Sub

 

[dinhduy]

Anh HieuCD ơi !

Em nghĩ như thế này anh xem có khả thi hơn không nha, excel thì làm được nhưng sẽ làm file chậm.
- Nếu là PN cột C2 trở đi ở sheet thì làm quét giá ở sheet giá (như cách trên).
- Nếu là PX thì dò tìm bên sheet XNT các trường như trên.
Ngoài ra, cho em hỏi mình có cần sắp xếp lại data không anh nhỉ?

Em cám ơn anh nhiều !

 

[HieuCD]

Anh HieuCD ơi !

Em nghĩ như thế này anh xem có khả thi hơn không nha, excel thì làm được nhưng sẽ làm file chậm.
- Nếu là PN cột C2 trở đi ở sheet thì làm quét giá ở sheet giá (như cách trên).
- Nếu là PX thì dò tìm bên sheet XNT các trường như trên.
Ngoài ra, cho em hỏi mình có cần sắp xếp lại data không anh nhỉ?

Em cám ơn anh nhiều !

Cấu trúc và trình tự vận hành file của bạn như thế nào mình không biết rỏ nên phải viết code chung chung
- Sheet PS cột C có gì để nhận biết nhập xuất
- Sheet GIA và NXT các dòng dữ liệu có khi nào 1 loại mà có 2 giá (đặc biệt sheet GIA)
Dữ liệu không cần sắp xếp

 

[dinhduy]

Cấu trúc và trình tự vận hành file của bạn như thế nào mình không biết rỏ nên phải viết code chung chung
- Sheet PS cột C có gì để nhận biết nhập xuất
- Sheet GIA và NXT các dòng dữ liệu có khi nào 1 loại mà có 2 giá (đặc biệt sheet GIA)
Dữ liệu không cần sắp xếp

Cách của anh viết người ngu như em cũng có thể thay đổi, rất dễ hiểu.
Như thế này nè anh.
PN là mình mua hàng sẽ lấy hoàn đơn giá từ Sheet GIA
PX là mình lấy từ sheet NXT là đơn giá bình quân gia quyền theo tháng.
(VD: Ngày 1 mua 10L giá 20k, ngày 17 mua 5L giá 10k, bình quân là 2k/L)
Ngoài ra, còn có cách tính theo FIFO là nhập trước xuất trước thì đòi hỏi cao hơn,
sẽ khó hơn, đòi hỏi sắp xếp dữ liệu theo thứ tự lấy dữ liệu từ trên xuống - em không chọn cách này.

Vì có người nói là không biết cách sắp xếp dữ liệu, không chỉ là phải sắp xếp như thế nào là cho đúng?
Sheet PS là sheet để nhập liệu, chủ yếu là phiếu nhập và phiếu xuất thôi.
Các sheet khác sẽ lấy dữ liệu từ đây qua, XNT, Công nợ, in Phiếu nhập, in Phiếu xuất... liên quan đến KHO.

Rất mong được sự giúp đỡ của anh rất nhiều !

 

[HieuCD]

Cách của anh viết người ngu như em cũng có thể thay đổi, rất dễ hiểu.
Như thế này nè anh.
PN là mình mua hàng sẽ lấy hoàn đơn giá từ Sheet GIA
PX là mình lấy từ sheet NXT là đơn giá bình quân gia quyền theo tháng.
(VD: Ngày 1 mua 10L giá 20k, ngày 17 mua 5L giá 10k, bình quân là 2k/L)
Ngoài ra, còn có cách tính theo FIFO là nhập trước xuất trước thì đòi hỏi cao hơn,
sẽ khó hơn, đòi hỏi sắp xếp dữ liệu theo thứ tự lấy dữ liệu từ trên xuống - em không chọn cách này.

Vì có người nói là không biết cách sắp xếp dữ liệu, không chỉ là phải sắp xếp như thế nào là cho đúng?
Sheet PS là sheet để nhập liệu, chủ yếu là phiếu nhập và phiếu xuất thôi.
Các sheet khác sẽ lấy dữ liệu từ đây qua, XNT, Công nợ, in Phiếu nhập, in Phiếu xuất... liên quan đến KHO.

Rất mong được sự giúp đỡ của anh rất nhiều !

File bạn gởi không có gì để biết nhập hay xuất

 

[dinhduy]

Em gửi Anh File đây ah !

File 1.000 dòng hơi chậm, thực tế khoảng 2.000 dòng ở sheet phát sinh, cứ lặp đi lặp lại thôi ah.
Em tìm cách cải thiện file, hơi chậm mà VBA em gần như chưa biết gì hết.

Thấy anh nhiệt tình giúp em, em cám ơn thật nhiều !

 

[HieuCD]

Em gửi Anh File đây ah !

File 1.000 dòng hơi chậm, thực tế khoảng 2.000 dòng ở sheet phát sinh, cứ lặp đi lặp lại thôi ah.
Em tìm cách cải thiện file, hơi chậm mà VBA em gần như chưa biết gì hết.

Thấy anh nhiệt tình giúp em, em cám ơn thật nhiều !

Chạy code

Sub GiaPS()
  Dim i As Long, key As String
  Dim Dic As Object, Arr As Variant, dArr As Variant
  Set Dic = CreateObject("Scripting.Dictionary")
  With Sheets("GIA")
    i = .Range("A" & Rows.Count).End(xlUp).Row
    If i > 1 Then
      dArr = .Range("A2:E" & i).Value
      For i = 1 To UBound(dArr, 1)
        If dArr(i, 1) <> "" And dArr(i, 3) <> "" Then
          key = dArr(i, 1) & "#" & dArr(i, 3)
          Dic.Item(key) = dArr(i, 5)
        End If
      Next i
    End If
  End With

  With Sheets("XNT")
    i = .Range("A" & Rows.Count).End(xlUp).Row
    If i > 9 Then
      dArr = .Range("A10:H" & i).Value
      For i = 1 To UBound(dArr, 1)
        If dArr(i, 1) <> "" And dArr(i, 2) <> "" Then
          key = dArr(i, 1) & "$" & dArr(i, 2)
          Dic.Item(key) = dArr(i, 8)
        End If
      Next i
    End If
  End With

  With Sheets("PS")
    i = .Range("A" & Rows.Count).End(xlUp).Row
    If i > 2 Then
      dArr = .Range("A3:G" & i).Value
      ReDim Arr(1 To UBound(dArr, 1), 1 To 1)
      For i = 1 To UBound(dArr, 1)
        If dArr(i, 3) <> "PN" Then
          If dArr(i, 1) <> "" And dArr(i, 7) <> "" Then
            key = dArr(i, 1) & "#" & dArr(i, 7)
            If Dic.exists(key) Then Arr(i, 1) = Dic.Item(key)
          End If
        ElseIf dArr(i, 6) <> "" And dArr(i, 7) <> "" Then
            key = dArr(i, 6) & "$" & dArr(i, 7)
            If Dic.exists(key) Then Arr(i, 1) = Dic.Item(key)
        End If
      Next i
    End If
    If IsArray(Arr) Then .Range("M3").Resize(UBound(Arr)) = Arr
  End With
End Sub

File bạn thiết kế không hợp lý như sheet PS bỏ các cột từ R đến AA, tạo 1 cột phụ là đủ tính sheet NXT
Công thức không nên chọn nguyên cột, tạo 1 ô tính dòng cuối cùng và dùng Offset để lấy đúng các dòng có dữ liệu
Không biết bạn tính giá ở sheet NXT kiểu gì, nếu là bình quân gia quyền cuối kỳ thì ổn
Không hiểu tại sao lấy code tính giá xuất theo mã kiện và mã VT, trong khi tính giá ở NXT chỉ dựa vào mã VT

 

[dinhduy]

Em cám ơn anh HieuCD nhiều lắm luôn, em làm được rồi.
Em cải thiện phần còn lại, chỗ nào không hiểu mong anh chỉ dạy thêm.

Giá Mã kiện như thế này anh, xem lô hàng đó do ai cung cấp, bán lô hàng đó cho người tác cũng chính bằng giá mình nhập vào luôn đó anh.
Giá XNT làm với Thuế thì đơn giản hơn chỉ có mã hàng là đủ rồi, bình quân gia quyền của tháng

 

[dinhduy]

Em chào Anh HieuCD ah !
Em mới bắt đầu tập tành học code VBA để hỗ trợ công việc tốt hơn.
Em làm phiền anh nhiều quá thì sẽ không hay.
Chỉ dám mong anh hỗ trợ giúp em cải tiến file này bằng VBA, cái này đối với e hiện tại là cần thiết nhất.
Hàm excel cũng đã chèn vào 1 số sheet tương đối hoàn thiện
- Sheet XNT
- Sheet CN
- Sheet PN
- Sheet PX
- Sheet PNX
- Sheet NXT là của kê thuế cũng giống như Sheet XNT
nhưng ở đây chỉ có ít trường hơn
+ Mã hàng - tên hàng - đvt
+ Tồn đầu kỳ
+ Số lượng nhập căn cứ vào loại PN (không có trường nhập khác)
+ Số lượng nhập căn cứ vào loại PX (không có trường xuất khác)
Ngoài ra, còn 3 sheet còn lại, em đang nghĩ dùng công thức để thiết lập trước bằng excel, các trường phù hợp.
Em chỉ biết cám ơn anh đã giúp đỡ em rất nhiều !

 

[HieuCD]

Em chào Anh HieuCD ah !
Em mới bắt đầu tập tành học code VBA để hỗ trợ công việc tốt hơn.
Em làm phiền anh nhiều quá thì sẽ không hay.
Chỉ dám mong anh hỗ trợ giúp em cải tiến file này bằng VBA, cái này đối với e hiện tại là cần thiết nhất.
Hàm excel cũng đã chèn vào 1 số sheet tương đối hoàn thiện
- Sheet XNT
- Sheet CN
- Sheet PN
- Sheet PX
- Sheet PNX
- Sheet NXT là của kê thuế cũng giống như Sheet XNT
nhưng ở đây chỉ có ít trường hơn
+ Mã hàng - tên hàng - đvt
+ Tồn đầu kỳ
+ Số lượng nhập căn cứ vào loại PN (không có trường nhập khác)
+ Số lượng nhập căn cứ vào loại PX (không có trường xuất khác)
Ngoài ra, còn 3 sheet còn lại, em đang nghĩ dùng công thức để thiết lập trước bằng excel, các trường phù hợp.
Em chỉ biết cám ơn anh đã giúp đỡ em rất nhiều !

File nầy vướng cách tính giá nên không thể làm gì tiếp
Vấn đề quan trọng là bạn phải mô tả qui trình nhập liệu và cách tính các chỉ tiêu của từng sheet theo trình tự trước sau, từ đó mới thiết kế lại các sheet dữ liệu lưu trữ (chưa tính tới các công thức tạo báo cáo) sau đó mới tính tiếp được

 

[dinhduy]

Em cám ơn 2 anh đã quan tâm hỗ trợ!
Nó là như thế này:

- Sheet PS là sheet nhập liệu chung hết
+ Đơn giá sẽ lấy từ Sheet NCC điền vào loại phiếu PN (mã nhà cung cấp + mã hàng)
+ Đơn giá xuất lấy từ Sheet NXT điền vào phiếu PX (căn cứ vào mã kiện + mã hàng)
Đơn giá xuất chỉ kho có đơn giá nhập mới có đơn giá để xuất.
. Click sự kiện 1 lấy đơn giá nhập điền vào phiếu PN Sheet PS
. Click sự kiện 2 Sheet NXT sẽ có đơn giá bình quân
. Click sự kiện 3 để lấy đơn giá vào phiếu PX ở Sheet PS
Nếu được thì có thể gộp lại chung vào 1 sự kiện thì quá tốt.
Ngoài ra, nếu chưa có giá thì mình để trống hoặc bằng 0, sẽ kiểm tra lại chỗ đó
Hôm trước anh HieuCD làm dùm em lọc mã trùng ở Sheet XNT và ẩn dòng trống,
có những nhiều dòng hay ít, mà cứ để công thức nhiều sẽ gây ảnh hưởng đến File.

- Sheet XNT được tính như sau:
+ Tồn đầu kỳ
Dựa vào Mã CC mặc định là KETCHUYEN, kết hợp với Mã Kiện và Mã Hàng từ tháng trước mang sang nhập ở Sheet PS luôn.
+ Nhập kho
Căn cứ vào Sheet PS để tính dựa các trường PN kết hợp Mã Kiện + Mã Hàng
+ Nhập khác
Căn cứ vào Sheet PS để tính dựa các trường NK kết hợp Mã Kiện + Mã Hàng
+ Xuất kho
Căn cứ vào Sheet PS để tính dựa các trường PX kết hợp Mã Kiện + Mã Hàng
+ Nhập khác
Căn cứ vào Sheet PS để tính dựa các trường XK kết hợp Mã Kiện + Mã Hàng
+ Tồn cuối kỳ
= Tồn đầu + nhập kho + nhập khác - xuất kho - xuất khác
+ Đơn giá bình quân (nếu linh động được thì tuyệt thời - giống cách viết của anh HieuCD)
Đối với kho gỗ hoặc MDF
= (TT tồn đầu kỳ + TT nhập kho + TT nhập khác)/(M3 tồn đầu kỳ + M3 nhập kho + M3 nhập khác)
Ngoài ra đối với các kho khác
= (TT tồn đầu kỳ + TT nhập kho + TT nhập khác)/(THANH tồn đầu kỳ + THANH nhập kho + THANH nhập khác)

Anh có cách nào hay hơn thì chỉ giúp em, em cám ơn các anh rất nhiều !

 

[dinhduy]

Góp ý. Chỉ nói về cách làm -> không nói về Code VBA trong file.

1. Công thức không tham chiếu cả cột khi viết công thức, ví dụ như : =SUMIFS(PS!M:M,PS!C:C,"KETCHUYEN",PS!H:H,A10,PS!I:I,B10)

2. Đã làm File NXT thì phải làm bài bản, bài bản ở đây có nghĩa là:

+ Nhập liệu được: nhập liệu 1 cách khoa học...
---> Chưa nói việc bạn nhập giá trong sheet nhập liệu của bạn. Mai này đổi giá thì sao??? Đè lại giá cũ ah? Nhập liệu kiểu vậy ---> đi ăn mày sớm!
+ Theo dõi được chi tiết, tổng hợp.
+ Theo dõi phải từ ngày tới ngày -> Tự động tính lại số dư đầu kỳ, cuối kỳ trong khoản thời gian...

3. Nhiều thứ lắm....
File bạn chưa đáp ứng được mấy cái cơ bản trên -> chưa gọi là hoàn thiện được.

Anh nói không sai, nếu được như anh nói là tuyệt vời không khác gì phần mềm ấy.
File của mình của chỉ làm từng tháng thôi, giá nhập vào gần như không thay đổi.
Nêu giá thay đổi thì mình sắp xếp như thế nào cho đúng, nhờ bạn hướng dẫn giúp mình.
Cám ơn anh rất nhiều !

 

[HieuCD]

Em cám ơn 2 anh đã quan tâm hỗ trợ!
Nó là như thế này:

- Sheet PS là sheet nhập liệu chung hết
+ Đơn giá sẽ lấy từ Sheet NCC điền vào loại phiếu PN (mã nhà cung cấp + mã hàng)
+ Đơn giá xuất lấy từ Sheet NXT điền vào phiếu PX (căn cứ vào mã kiện + mã hàng)
Đơn giá xuất chỉ kho có đơn giá nhập mới có đơn giá để xuất.
. Click sự kiện 1 lấy đơn giá nhập điền vào phiếu PN Sheet PS
. Click sự kiện 2 Sheet NXT sẽ có đơn giá bình quân
. Click sự kiện 3 để lấy đơn giá vào phiếu PX ở Sheet PS
Nếu được thì có thể gộp lại chung vào 1 sự kiện thì quá tốt.
Ngoài ra, nếu chưa có giá thì mình để trống hoặc bằng 0, sẽ kiểm tra lại chỗ đó
Hôm trước anh HieuCD làm dùm em lọc mã trùng ở Sheet XNT và ẩn dòng trống,
có những nhiều dòng hay ít, mà cứ để công thức nhiều sẽ gây ảnh hưởng đến File.

- Sheet XNT được tính như sau:
+ Tồn đầu kỳ
Dựa vào Mã CC mặc định là KETCHUYEN, kết hợp với Mã Kiện và Mã Hàng từ tháng trước mang sang nhập ở Sheet PS luôn.
+ Nhập kho
Căn cứ vào Sheet PS để tính dựa các trường PN kết hợp Mã Kiện + Mã Hàng
+ Nhập khác
Căn cứ vào Sheet PS để tính dựa các trường NK kết hợp Mã Kiện + Mã Hàng
+ Xuất kho
Căn cứ vào Sheet PS để tính dựa các trường PX kết hợp Mã Kiện + Mã Hàng
+ Nhập khác
Căn cứ vào Sheet PS để tính dựa các trường XK kết hợp Mã Kiện + Mã Hàng
+ Tồn cuối kỳ
= Tồn đầu + nhập kho + nhập khác - xuất kho - xuất khác
+ Đơn giá bình quân (nếu linh động được thì tuyệt thời - giống cách viết của anh HieuCD)
Đối với kho gỗ hoặc MDF
= (TT tồn đầu kỳ + TT nhập kho + TT nhập khác)/(M3 tồn đầu kỳ + M3 nhập kho + M3 nhập khác)
Ngoài ra đối với các kho khác
= (TT tồn đầu kỳ + TT nhập kho + TT nhập khác)/(THANH tồn đầu kỳ + THANH nhập kho + THANH nhập khác)

Anh có cách nào hay hơn thì chỉ giúp em, em cám ơn các anh rất nhiều !

1/ Sheet PS bạn nhập tay hay lấy từ phần mềm? và gồm có dữ liệu cột nào? cột nào để trống
2/ Sheet phát sinh nhập trong thời gian 1 tháng, 1 năm hay nhiều năm?
3/ Làm sao biết: Đối với kho gỗ hoặc MDF?
4/ Đơn giá XNT bạn tính dựa vào cột M3 nhưng không có số liệu thì làm sao tính?
5/ Tại sao một số lại không có giá
Trong file dữ liệu không cần nhiều dòng, nhưng phải có đầy đủ các cột và các trường hợp có khả năng xảy ra mới giải quyết được, nhiều cột không có dữ liệu là thua không làm gì được

 

[dinhduy]

Là như vậy nè anh HieuCD !
1. Sheet PS em dùm add-in Input From List để nhập liệu nâng cao
- Mã CC và Nhà cung cấp lấy từ Sheet NCC
- Mã vật tư, tên vật tư, đvt, hệ số quy đổi lấy từ sheet VT
- Số lượng M3 = Số lượng * hệ số quy đổi
- Thành tiền tính bằng công thức
+ Nếu không M3 thì số lượng * đơn giá
+ Nếu có M3 thì M3 * đơn giá
Những trường khác nhập bằng tay anh
2. Sheet PS nhập từng tháng (File kho dự kiến sẽ có 10 sheet) hỗ trợ cho việc Nội Bộ + Thuế
3. Nếu kho gỗ hay MDF sẽ có hệ số quy đổi là M3 - được tính ở sẵn Sheet VT
4. Vì những vật tư khác sẽ có đơn vị tính là M3 hoặc mình cũng có thể để mặc định là hệ số quy đổi là 1
5. Không có giá từ Xưởng 1 mang qua Xưởng 2, để mình theo dõi (nội bộ) không có giá sẽ là phiếu NK hay XK.
=>
- Khi có hóa đơn về mình sẽ nhập hóa đơn và ngày hóa đơn vào ở Sheet PS
- Hóa đơn sẽ được lấy qua sheet cuối để kê hóa đơn đầu vào Sheet KT gồm những trường:
+ Ngày hóa đơn
+ Số hóa đơn
+ Nhà cung cấp
+ Thành tiền

- Sheet NXT chính là xuất nhập tồn của thuế, loại bỏ bằng tay những cái nhập không có hóa đơn
+ Mã hàng và tên hàng
+ Tồn đầu kỳ (phải tự dùng hàm để quét)
+ Nhập kho, chỉ lấy phiếu PN, còn phiếu NK sẽ bị loại
+ Xuất kho, chỉ lấy phiếu PX, còn phiếu XK sẽ bị loại
+ Tồn cuối = tồn đầu + nhập kho - xuất kho

Em cập nhật ở đây nè anh !

Rất mong được sự đóng góp của anh !

 

[HieuCD]

Là như vậy nè anh HieuCD !
1. Sheet PS em dùm add-in Input From List để nhập liệu nâng cao
- Mã CC và Nhà cung cấp lấy từ Sheet NCC
- Mã vật tư, tên vật tư, đvt, hệ số quy đổi lấy từ sheet VT
- Số lượng M3 = Số lượng * hệ số quy đổi
- Thành tiền tính bằng công thức
+ Nếu không M3 thì số lượng * đơn giá
+ Nếu có M3 thì M3 * đơn giá
Những trường khác nhập bằng tay anh
2. Sheet PS nhập từng tháng (File kho dự kiến sẽ có 10 sheet) hỗ trợ cho việc Nội Bộ + Thuế
3. Nếu kho gỗ hay MDF sẽ có hệ số quy đổi là M3 - được tính ở sẵn Sheet VT
4. Vì những vật tư khác sẽ có đơn vị tính là M3 hoặc mình cũng có thể để mặc định là hệ số quy đổi là 1
5. Không có giá từ Xưởng 1 mang qua Xưởng 2, để mình theo dõi (nội bộ) không có giá sẽ là phiếu NK hay XK.
=>
- Khi có hóa đơn về mình sẽ nhập hóa đơn và ngày hóa đơn vào ở Sheet PS
- Hóa đơn sẽ được lấy qua sheet cuối để kê hóa đơn đầu vào Sheet KT gồm những trường:
+ Ngày hóa đơn
+ Số hóa đơn
+ Nhà cung cấp
+ Thành tiền

- Sheet NXT chính là xuất nhập tồn của thuế, loại bỏ bằng tay những cái nhập không có hóa đơn
+ Mã hàng và tên hàng
+ Tồn đầu kỳ (phải tự dùng hàm để quét)
+ Nhập kho, chỉ lấy phiếu PN, còn phiếu NK sẽ bị loại
+ Xuất kho, chỉ lấy phiếu PX, còn phiếu XK sẽ bị loại
+ Tồn cuối = tồn đầu + nhập kho - xuất kho

Em cập nhật ở đây nè anh !

Rất mong được sự đóng góp của anh !

Viết lại code tính giá, code trước theo qui trình của bạn là không đúng, và chỉnh tạm vài công thức cho nhẹ file, nhưng vẫn không tính được giá xuất kho của nhiều vật liệu
Bạn xem lại 3 sheet trong file, khi nào ổn mới tính tới chuyện khác
File vừa nhập tay vừa dùng phần mềm nhập trước sau gì cũng bị lỗi

 

[dinhduy]

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ỉ ?

 

[HieuCD]

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

 

[dinhduy]

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

 

[HieuCD]

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

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

 

[dinhduy]

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!

 

[HieuCD]

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?

 

[dinhduy]

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 !

 

[dinhduy]

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 !

 

[HieuCD]

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ì?

 

[dinhduy]

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!

 

[thanhthat]

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ị !

 

[thanhthat]

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.

 

[TheThienChu]

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

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

 

[excel_lv1.5]

Chạy đoạn code này xem sao

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?

 

[TheThienChu]

.Remove Cll.Value chỗ này chắc đúng không bạn?

Dán code lên mới nhận ra, sửa lại bài trên rồi bạn

 

[thanhthat]

Chạy đoạn code này xem sao

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 !

 

[thanhthat]

Chạy đoạn code này xem sao

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 !!

 

[thanhthat]

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 !!

Các AC chỉnh sữa giúp với !!!

 

[HieuCD]

Các AC chỉnh sữa giúp với !!!

Gởi file thật với dữ liệu giả định lên

 

[thanhthat]

Gởi file thật với dữ liệu giả định lên

Mình Uolad file rồi nhờ Bạn giúp với !

 

[HieuCD]

Mình Uolad file rồi nhờ Bạn giúp với !

file đâu có khác gì file trước

Public Sub GPE()
  Dim Sh As Worksheet
  Dim dArr, Arr, key As Variant
  Dim i, k, lRow As Long
  Dim ShName, Col As String
  On Error Resume Next
  Col = InputBox("Nhap Ky Tu Cot muon tim, nhu A, B, C ... ")
Trolai:
  i = Range(Col & "1").Row
  If Err.Number Then
    Err.Clear
    Col = InputBox("Nhap sai, Nhap lai Ky Tu Cot muon tim, nhu A, B, C ... ")
    GoTo Trolai
  End If
  Col = UCase(Col)
  With CreateObject("Scripting.Dictionary")
    For Each Sh In Worksheets
      ShName = Sh.Name
      If ShName <> "Sheet1" Then
        lRow = Sh.Range(Col & Rows.Count).End(xlUp).Row
        If lRow = 1 Then lRow = 2
        dArr = Sh.Range(Col & 1).Resize(lRow).Value
        For i = 1 To UBound(dArr)
          key = dArr(i, 1)
          If key <> "" Then
            If Not .exists(key) Then
              .Add key, Array(ShName, Col & i)
            Else
              If IsArray(.Item(key)) Then .Item(key) = 1
            End If
          End If
        Next i
      End If
    Next Sh
    ReDim Arr(1 To .Count, 1 To 3)
    For i = 0 To .Count - 1
      dArr = .items()(i)
      If IsArray(dArr) Then
        k = k + 1
        Arr(k, 1) = dArr(0): Arr(k, 2) = dArr(1): Arr(k, 3) = .keys()(i)
      End If
    Next i
  End With
  With Sheet1
    .Range("A2", .Range("C" & .Range("A2").End(xlDown).Row)).ClearContents
    .Range("A2").Resize(k, 3) = Arr
  End With
End Sub

 

[thanhthat]

file đâu có khác gì file trước

Public Sub GPE()
  Dim Sh As Worksheet
  Dim dArr, Arr, key As Variant
  Dim i, k, lRow As Long
  Dim ShName, Col As String
  On Error Resume Next
  Col = InputBox("Nhap Ky Tu Cot muon tim, nhu A, B, C ... ")
Trolai:
  i = Range(Col & "1").Row
  If Err.Number Then
    Err.Clear
    Col = InputBox("Nhap sai, Nhap lai Ky Tu Cot muon tim, nhu A, B, C ... ")
    GoTo Trolai
  End If
  Col = UCase(Col)
  With CreateObject("Scripting.Dictionary")
    For Each Sh In Worksheets
      ShName = Sh.Name
      If ShName <> "Sheet1" Then
        lRow = Sh.Range(Col & Rows.Count).End(xlUp).Row
        If lRow = 1 Then lRow = 2
        dArr = Sh.Range(Col & 1).Resize(lRow).Value
        For i = 1 To UBound(dArr)
          key = dArr(i, 1)
          If key <> "" Then
            If Not .exists(key) Then
              .Add key, Array(ShName, Col & i)
            Else
              If IsArray(.Item(key)) Then .Item(key) = 1
            End If
          End If
        Next i
      End If
    Next Sh
    ReDim Arr(1 To .Count, 1 To 3)
    For i = 0 To .Count - 1
      dArr = .items()(i)
      If IsArray(dArr) Then
        k = k + 1
        Arr(k, 1) = dArr(0): Arr(k, 2) = dArr(1): Arr(k, 3) = .keys()(i)
      End If
    Next i
  End With
  With Sheet1
    .Range("A2", .Range("C" & .Range("A2").End(xlDown).Row)).ClearContents
    .Range("A2").Resize(k, 3) = Arr
  End With
End Sub

Đúng vậy, Em chỉ muốn tìm trên cột theo ý mình. Ok rồi Anh ạ!
Cám ơn Anh !

 

[thanhthat]

Đúng vậy, Em chỉ muốn tìm trên cột theo ý mình. Ok rồi Anh ạ!
Cám ơn Anh !

Có một yêu cầu nhỏ nhờ Bạn giúp mình: Bạn chỉnh code khong phân biệt chữ Hoa chữ thường mình với như file mình Up lại.
Các AC sữa code giúp mình đang cần !!!
Cám ơn !

 

[thanhthat]

file đâu có khác gì file trước

Public Sub GPE()
  Dim Sh As Worksheet
  Dim dArr, Arr, key As Variant
  Dim i, k, lRow As Long
  Dim ShName, Col As String
  On Error Resume Next
  Col = InputBox("Nhap Ky Tu Cot muon tim, nhu A, B, C ... ")
Trolai:
  i = Range(Col & "1").Row
  If Err.Number Then
    Err.Clear
    Col = InputBox("Nhap sai, Nhap lai Ky Tu Cot muon tim, nhu A, B, C ... ")
    GoTo Trolai
  End If
  Col = UCase(Col)
  With CreateObject("Scripting.Dictionary")
    For Each Sh In Worksheets
      ShName = Sh.Name
      If ShName <> "Sheet1" Then
        lRow = Sh.Range(Col & Rows.Count).End(xlUp).Row
        If lRow = 1 Then lRow = 2
        dArr = Sh.Range(Col & 1).Resize(lRow).Value
        For i = 1 To UBound(dArr)
          key = dArr(i, 1)
          If key <> "" Then
            If Not .exists(key) Then
              .Add key, Array(ShName, Col & i)
            Else
              If IsArray(.Item(key)) Then .Item(key) = 1
            End If
          End If
        Next i
      End If
    Next Sh
    ReDim Arr(1 To .Count, 1 To 3)
    For i = 0 To .Count - 1
      dArr = .items()(i)
      If IsArray(dArr) Then
        k = k + 1
        Arr(k, 1) = dArr(0): Arr(k, 2) = dArr(1): Arr(k, 3) = .keys()(i)
      End If
    Next i
  End With
  With Sheet1
    .Range("A2", .Range("C" & .Range("A2").End(xlDown).Row)).ClearContents
    .Range("A2").Resize(k, 3) = Arr
  End With
End Sub

Anh HiueCD chỉnh lại code mà không phân biệt chữ hoa và chữ thường em với. Code về mảng em không rành lắm.
Cám ơn Anh !

 

[HieuCD]

Anh HiueCD chỉnh lại code mà không phân biệt chữ hoa và chữ thường em với. Code về mảng em không rành lắm.
Cám ơn Anh !

Dùng hàm Ucase để chuyển key về chữ in

Public Sub GPE()
  Dim Sh As Worksheet
  Dim dArr, Arr, key As Variant
  Dim i, k, lRow As Long
  Dim ShName, Col As String
  On Error Resume Next
  Col = InputBox("Nhap Ky Tu Cot muon tim, nhu A, B, C ... ")
Trolai:
  i = Range(Col & "1").Row
  If Err.Number Then
    Err.Clear
    Col = InputBox("Nhap sai, Nhap lai Ky Tu Cot muon tim, nhu A, B, C ... ")
    GoTo Trolai
  End If
  Col = UCase(Col)
  With CreateObject("Scripting.Dictionary")
    For Each Sh In Worksheets
      ShName = Sh.Name
      If ShName <> "Sheet1" Then
        lRow = Sh.Range(Col & Rows.Count).End(xlUp).Row
        If lRow = 1 Then lRow = 2
        dArr = Sh.Range(Col & 1).Resize(lRow).Value
        For i = 1 To UBound(dArr)
          key = UCase(dArr(i, 1))
          If key <> "" Then
            If Not .exists(key) Then
              .Add key, Array(ShName, Col & i, dArr(i, 1))
            Else
              If IsArray(.Item(key)) Then .Item(key) = 1
            End If
          End If
        Next i
      End If
    Next Sh
    ReDim Arr(1 To .Count, 1 To 3)
    For i = 0 To .Count - 1
      dArr = .items()(i)
      If IsArray(dArr) Then
        k = k + 1
        Arr(k, 1) = dArr(0): Arr(k, 2) = dArr(1): Arr(k, 3) = dArr(2)
      End If
    Next i
  End With
  With Sheet1
    .Range("A2", .Range("C" & .Range("A2").End(xlDown).Row)).ClearContents
    .Range("A2").Resize(k, 3) = Arr
  End With
End Sub

 

[thanhthat]

Chào các Anh Chị Diễn đàn GPE !
Sau khi tìm được các giá trị không trùng thì lại phải ngồi copy từng dòng số liệu mà số liệu thì lớn quá nên vật vã lắm. Em nhờ các Anh Chị code thêm phần copy dòng số liệu không trùng đó về sheet1 như file đính kèm.
Ps: Em đang cần gấp ạ !
Em cám ơn !

 

[HieuCD]

Chào các Anh Chị Diễn đàn GPE !
Sau khi tìm được các giá trị không trùng thì lại phải ngồi copy từng dòng số liệu mà số liệu thì lớn quá nên vật vã lắm. Em nhờ các Anh Chị code thêm phần copy dòng số liệu không trùng đó về sheet1 như file đính kèm.
Ps: Em đang cần gấp ạ !
Em cám ơn !

Đã có địa chỉ, lấy thêm dữ liệu các cột khác không khó đâu, bạn tự viết code, có gì mình chỉnh lại

ReDim Arr(1 To .Count, 1 To 3) chỉnh số 3 lại

k = k + 1
Arr(k, 1) = dArr(0): Arr(k, 2) = dArr(1): Arr(k, 3) = dArr(2)
thêm các lệnh Arr(k, 4) = .... hoặc dùng for

chỉnh lại lệnh xuất kết quả

 

[thanhthat]

Đã có địa chỉ, lấy thêm dữ liệu các cột khác không khó đâu, bạn tự viết code, có gì mình chỉnh lại

ReDim Arr(1 To .Count, 1 To 3) chỉnh số 3 lại

k = k + 1
Arr(k, 1) = dArr(0): Arr(k, 2) = dArr(1): Arr(k, 3) = dArr(2)
thêm các lệnh Arr(k, 4) = .... hoặc dùng for

chỉnh lại lệnh xuất kết quả

Em đang bận với nhiều số liệu nên cũng chưa viết đc với lai viết về mảng em không có rành lắm. Cám ơn anh nhiều.

 

[NguyenNgocThuHien]

Em đang bận với nhiều số liệu nên cũng chưa viết đc với lai viết về mảng em không có rành lắm. Cám ơn anh nhiều.

Đọc kỹ hướng dẫn trước khi chạy code.

 

[fullmoon2111]

Dear anh chị
Em có hai sheet có cột dữ liệu project code : Sheet "Project 2018" và sheet "finished". Em muốn tạo sheet "WIP" có mẫu giống như sheet 'project 2018" nhưng loại bỏ các project code đã có trong sheet "finished". Em nhờ anh chị giúp em tạo code VBA ạ. Em xin cám ơn ạ

 

[PacificPR]

Dear anh chị
Em có hai sheet có cột dữ liệu project code : Sheet "Project 2018" và sheet "finished". Em muốn tạo sheet "WIP" có mẫu giống như sheet 'project 2018" nhưng loại bỏ các project code đã có trong sheet "finished". Em nhờ anh chị giúp em tạo code VBA ạ. Em xin cám ơn ạ

 Sub Laydulieu()
    Dim Dic As Object, sArr(), dArr(), tArr()
    Dim I As Long, J As Long, K As Long
Set Dic = CreateObject("Scripting.Dictionary")
With Sheets("Finished services")
    tArr = .Range("K6", .Range("K" & Rows.Count).End(3)).Value
End With
For I = 1 To UBound(tArr)
    Dic.Item(CStr(tArr(I, 1))) = I
Next I
With Sheets("Project 2018")
    sArr = .Range("A4", .Range("A" & Rows.Count).End(3)).Resize(, 21).Value
    ReDim dArr(1 To UBound(sArr, 1), 1 To UBound(sArr, 2))
    For I = 1 To UBound(sArr)
        If Not Dic.Exists(CStr(sArr(I, 4))) Then
            K = K + 1
            For J = 1 To 21
                dArr(K, J) = sArr(I, J)
            Next J
        End If
    Next I
End With
With Sheets("WIP")
    If K Then
        .Range("A4:X10000").ClearContents
        .Range("A4").Resize(K, UBound(sArr, 2)) = dArr
    End If
End With
Set Dic = Nothing
End Sub

 

[Hoang2013]

Macro của bạn đây (tuy chậm chân rồi); Chúc vui vẻ & thành công:

Sub CopyRowsNotInFinishedServices()
 Dim Arr(), Sh As Worksheet, sArr(), Tmp As Boolean
 Dim Rws As Long, Col As Byte, J As Long, Dm As Byte, W As Long, Z As Long

 Sheets("Project 2018").Select
 Rws = [d3].CurrentRegion.Rows.Count
 Col = [d3].CurrentRegion.Columns.Count
 Arr() = [a4].Resize(Rws, Col).Value
 ReDim dArr(1 To Rws, 1 To Col)
 Sheets("WIP").[a4].Resize(Rws, Col).Value = dArr()
 With Sheets("Finished services")
    Rws = .[b5].CurrentRegion.Rows.Count
    sArr() = .[k6].Resize(Rws).Value
 End With
 For J = 1 To UBound(Arr())
    For Z = 1 To UBound(sArr())
        If Arr(J, 4) = sArr(Z, 1) Then
            Tmp = True:         Exit For
        End If
    Next Z
    If Tmp Then
        Tmp = False
    Else
        W = W + 1
        For Dm = 1 To Col
            dArr(W, Dm) = Arr(J, Dm)
        Next Dm
    End If
 Next J
 Sheets("WIP").[a4].Resize(W, Col).Value = dArr()
End Sub

 

[fullmoon2111]

 Sub Laydulieu()
    Dim Dic As Object, sArr(), dArr(), tArr()
    Dim I As Long, J As Long, K As Long
Set Dic = CreateObject("Scripting.Dictionary")
With Sheets("Finished services")
    tArr = .Range("K6", .Range("K" & Rows.Count).End(3)).Value
End With
For I = 1 To UBound(tArr)
    Dic.Item(CStr(tArr(I, 1))) = I
Next I
With Sheets("Project 2018")
    sArr = .Range("A4", .Range("A" & Rows.Count).End(3)).Resize(, 21).Value
    ReDim dArr(1 To UBound(sArr, 1), 1 To UBound(sArr, 2))
    For I = 1 To UBound(sArr)
        If Not Dic.Exists(CStr(sArr(I, 4))) Then
            K = K + 1
            For J = 1 To 21
                dArr(K, J) = sArr(I, J)
            Next J
        End If
    Next I
End With
With Sheets("WIP")
    If K Then
        .Range("A4:X10000").ClearContents
        .Range("A4").Resize(K, UBound(sArr, 2)) = dArr
    End If
End With
Set Dic = Nothing
End Sub

**
Mình đã thử rồi nhưng giá trị ở cột Cost-USD và Cost - VND không hiện lên ạ

 

[fullmoon2111]

Macro của bạn đây (tuy chậm chân rồi); Chúc vui vẻ & thành công:

Sub CopyRowsNotInFinishedServices()
 Dim Arr(), Sh As Worksheet, sArr(), Tmp As Boolean
 Dim Rws As Long, Col As Byte, J As Long, Dm As Byte, W As Long, Z As Long

 Sheets("Project 2018").Select
 Rws = [d3].CurrentRegion.Rows.Count
 Col = [d3].CurrentRegion.Columns.Count
 Arr() = [a4].Resize(Rws, Col).Value
 ReDim dArr(1 To Rws, 1 To Col)
 Sheets("WIP").[a4].Resize(Rws, Col).Value = dArr()
 With Sheets("Finished services")
    Rws = .[b5].CurrentRegion.Rows.Count
    sArr() = .[k6].Resize(Rws).Value
 End With
 For J = 1 To UBound(Arr())
    For Z = 1 To UBound(sArr())
        If Arr(J, 4) = sArr(Z, 1) Then
            Tmp = True:         Exit For
        End If
    Next Z
    If Tmp Then
        Tmp = False
    Else
        W = W + 1
        For Dm = 1 To Col
            dArr(W, Dm) = Arr(J, Dm)
        Next Dm
    End If
 Next J
 Sheets("WIP").[a4].Resize(W, Col).Value = dArr()
End Sub

Mình đã thử nhung trên sheet WIP vẫn còn giá trị trùng ạ. VD : project code 37743 đã có trên sheet Finishes thì không có trên sheet WIP nữa ạ.

 

[fullmoon2111]

**
Mình đã thử rồi nhưng giá trị ở cột Cost-USD và Cost - VND không hiện lên ạ

Mình đã sửa được rồi bạn nhé. cám ơn bạn nhiều ạ

 

[LamNA]

2 cột điểm thì cũng vẫn dùng Consolidate thôi ---> Add vào 2 vùng C225 và C2:E5
Để bạn đở mất công làm bằng tay, tôi viết nó thành code... bạn chỉ việc nhấn nút là xong!

Sub DiemTB()
  Range("I1").CurrentRegion.Offset(1).ClearContents
  With Range([C2], [C65536].End(xlUp))
    Range("I2").Consolidate _
    Array(.Resize(, 2).Address(, , 2), .Resize(, 3).Address(, , 2)), 1, False, True
  End With
End Sub

Thầy cho em hỏi, em muốn đổi điểm trung bình thành tổng điểm thì mình sữa lại chỗ nào.
Em thấy code thầy hay và gọn nên áp dụng
Em cám ơn

 

[ndu96081631]

Thầy cho em hỏi, em muốn đổi điểm trung bình thành tổng điểm thì mình sữa lại chỗ nào.
Em thấy code thầy hay và gọn nên áp dụng
Em cám ơn

Chỗ này:

Array(.Resize(, 2).Address(, , 2), .Resize(, 3).Address(, , 2)), 1, False, True

Số 1 sửa thành số 9 nghĩa là SUM

 

[LamNA]

Chỗ này:

Số 1 sửa thành số 9 nghĩa là SUM

Dạ em cám ơn thầy

 

[LamNA]

Bạn cứ thử sửa lại như vầy xem sao:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Range("[COLOR=red]F2:G65536[/COLOR]").Clear
  With Range("[COLOR=red]B2:C[/COLOR]" & [[COLOR=red]B65536[/COLOR]].End(xlUp).Row)
     Range("[COLOR=red]F2[/COLOR]").Consolidate .Address(, , 2), Function:=xlSum, LeftColumn:=True
  End With
End Sub

Chào anh
Em muốn lọc trùng như vậy mà qua sheet"Total" thì mình chỉnh code như thế nào anh, nhờ anh giúp đỡ
Em cám ơn

 

[befaint]

lọc LOẠI BỎ trùng như sheet"Total"

 

[LamNA]

Em cám ơn anh đã hỗ trơ

 

[huongmuine]

Mình có dữ liệu ở cột B. Mình muốn lọc duy nhất và sort theo thứ tự lớn dần rồi ghi kết quả từ G21, từ G21:G32 nếu dòng nào không có dữ liệu sẽ ẩn đi.
Nhờ các anh chị giúp dùm. Cảm ơn!

 

[Phan Thế Hiệp]

Mình có dữ liệu ở cột B. Mình muốn lọc duy nhất và sort theo thứ tự lớn dần rồi ghi kết quả từ G21, từ G21:G32 nếu dòng nào không có dữ liệu sẽ ẩn đi.
Nhờ các anh chị giúp dùm. Cảm ơn!

Thử:

G21=IFERROR(AGGREGATE(15,6,$B$3:$B$100/(COUNTIF(OFFSET($B$3,,,ROW($1:$100)),$B$3:$B$100)=1),ROW($A1)),"")

Thân.

 

[huongmuine]

Thử:

G21=IFERROR(AGGREGATE(15,6,$B$3:$B$100/(COUNTIF(OFFSET($B$3,,,ROW($1:$100)),$B$3:$B$100)=1),ROW($A1)),"")

Thân.

Cảm ơn bạn giúp đỡ.

 

[phulien1902]

Mình có dữ liệu ở cột B. Mình muốn lọc duy nhất và sort theo thứ tự lớn dần rồi ghi kết quả từ G21, từ G21:G32 nếu dòng nào không có dữ liệu sẽ ẩn đi.
Nhờ các anh chị giúp dùm. Cảm ơn!

Làm theo File của bạn, code:

Sub abc()
    With Sheet1
        .Range("B3:B15").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheet1.Range("H21"), Unique:=True
        .Range("G21:G100").Sort Key1:=Range("G21"), Order1:=xlAscending
    End With
End Sub

 

[huongmuine]

Làm theo File của bạn, code:

Sub abc()
    With Sheet1
        .Range("B3:B15").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheet1.Range("H21"), Unique:=True
        .Range("G21:H100").Sort Key1:=Range("H21"), Order1:=xlAscending
    End With
End Sub

Bạn thêm giúp code để ẩn dòng từ G21:G32 nếu các dòng này không có dữ liệu.
Cảm ơn bạn đã giúp.

 

[phulien1902]

Bạn thêm giúp code để ẩn dòng từ G21:G32 nếu các dòng này không có dữ liệu.
Cảm ơn bạn đã giúp.

Chỉ có thế này thôi:

 Range("G21:G32").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True

 

[huongmuine]

Chỉ có thế này thôi:

 Range("G21:G32").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True

Sao mình thêm vào thì nó ẩn luôn các dòng có dữ liệu bạn ạ.

 

[phulien1902]

Sao mình thêm vào thì nó ẩn luôn các dòng có dữ liệu bạn ạ.

Bạn xem lại có phải cột G không? Nếu bạn vẫn chưa làm được, thì bạn chụp ảnh các dòng cần ẩn lên đây.

 

[huongmuine]

Chỉ có thế này thôi:

 Range("G21:G32").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True

Nếu mình chỉnh thành cột H thì code không hoạt động. Bạn xem giúp mình với.

 

[phulien1902]

Nếu mình chỉnh thành cột H thì code không hoạt động. Bạn xem giúp mình với.

Ẩn bình thường đấy thôi( Code ẩn vùng màu vàng trong File)

 

[huongmuine]

Ẩn bình thường đấy thôi( Code ẩn vùng màu vàng trong File)

Cảm ơn bạn đã nhiệt tình giúp đỡ.
Chúc bạn có một buổi chiều nhiều niềm vui.

 

[phuc90]

mấy anh cho em hỏi em làm bảng excel đánh giá điểm nhân viên hàng tháng, em dùng lệnh importrance kết xuất dữ liệu giữa các sheet mà bây giờ có dữ liệu trùng em ko xóa được các anh chỉ dùm em cách xử lý để xóa dữ liệu cột trùng nha các anh, cám ơn các anh nhiều

Bài đã được tự động gộp: 21/1/19

mấy anh cho em hỏi em làm bảng excel đánh giá điểm nhân viên hàng tháng, em dùng lệnh importrance kết xuất dữ liệu giữa các sheet mà bây giờ có dữ liệu trùng em ko xóa được các anh chỉ dùm em cách xử lý để xóa dữ liệu cột trùng nha các anh, cám ơn các anh nhiều, em sử dụng google drive để đánh giá qua gmail của từng nhân viên

 

[TIEUTOT]

Kính chào các Anh Chị diễn đàn !
Nhờ các Anh Chị hỗ trợ giúp Em cái file này với!
Em xin cảm ơn trước

 

[SA_DQ]

Sub LocDuLieuDuyNhat()
Dim Dict As Object, iRow As Long, I As Long
Dim TmpArr As Variant
 
Set Dict = CreateObject("Scripting.Dictionary")
With Sheets("DuLieu")
    iRow = .[a65500].End(xlUp).Row
    TmpArr = .[A2].Resize(iRow).Value
    ReDim Arr(1 To iRow, 1 To 1) As String
    Sheets("Ket Qua").Range("A2").CurrentRegion.ClearContents
    For iRow = 1 To UBound(TmpArr, 1)
        If Len(TmpArr(iRow, 1)) > 0 And Not Dict.exists(TmpArr(iRow, 1)) Then
            I = I + 1:                                  Arr(I, 1) = TmpArr(iRow, 1)
             Dict.Add TmpArr(iRow, 1), I
        End If
    Next iRow
    If I Then Sheets("Ket Qua").Range("A2").Resize(I).Value = Arr
End With
End Sub

Lần sau nên chăng ta lập chủ đề mới nha bạn!

 

[phulien1902]

Kính chào các Anh Chị diễn đàn !
Nhờ các Anh Chị hỗ trợ giúp Em cái file này với!
Em xin cảm ơn trước

1 cách:

Sub Test()
    Dim d As Object, Arr, i&, LR&
    Set d = CreateObject("Scripting.Dictionary")
    With Sheets("Dulieu").Range("A2:a1100")
        .AutoFilter Field:=1, Criteria1:=""
        .SpecialCells(xlCellTypeVisible).EntireRow.Delete
    End With
    With Sheets("Dulieu")
        LR = .Cells(Rows.Count, 1).End(xlUp).Row
        Arr = .Range("A2:A" & LR)
        For i = 1 To UBound(Arr, 1)
            d(Arr(i, 1)) = 1
        Next i
    End With
    Sheets("Ket qua").Range("A2").Resize(d.Count) = Application.Transpose(d.keys)
End Sub

 

[TIEUTOT]

1 cách:

Sub Test()
    Dim d As Object, Arr, i&, LR&
    Set d = CreateObject("Scripting.Dictionary")
    With Sheets("Dulieu").Range("A2:a1100")
        .AutoFilter Field:=1, Criteria1:=""
        .SpecialCells(xlCellTypeVisible).EntireRow.Delete
    End With
    With Sheets("Dulieu")
        LR = .Cells(Rows.Count, 1).End(xlUp).Row
        Arr = .Range("A2:A" & LR)
        For i = 1 To UBound(Arr, 1)
            d(Arr(i, 1)) = 1
        Next i
    End With
    Sheets("Ket qua").Range("A2").Resize(d.Count) = Application.Transpose(d.keys)
End Sub

Em cảm ơn nhiều!. Trường hợp em muốn giữ nguyên trạng thái dữ liệu ở cột A trong sheet Dulieu thì phải thay đổi như thế nào?

 

[phulien1902]

Em cảm ơn nhiều!. Trường hợp em muốn giữ nguyên trạng thái dữ liệu ở cột A trong sheet Dulieu thì phải thay đổi như thế nào?

Vậy thì bạn thay bằng:

Sub Test2()
    Dim d As Object, Arr, i&, LR&
    Set d = CreateObject("Scripting.Dictionary")
    With Sheets("Dulieu").Range("A2:a1100")
        .AutoFilter 1, "<>"
        .Offset(1).Copy Sheets("Ket qua").Range("A2")
        .AutoFilter
    End With
    With Sheets("Ket qua")
        LR = .Cells(Rows.Count, 1).End(xlUp).Row
        Arr = .Range("A2:A" & LR)
        For i = 1 To UBound(Arr, 1)
            d(Arr(i, 1)) = 1
        Next i
        .Range("B2").Resize(d.Count) = Application.Transpose(d.keys)
        .Columns(1).Delete
    End With
End Sub

 

[TIEUTOT]

Lần sau nên chăng ta lập chủ đề mới nha bạn!

Em cảm ơn nhiều ạ!

 

[Ba Tê]

Em cảm ơn nhiều!. Trường hợp em muốn giữ nguyên trạng thái dữ liệu ở cột A trong sheet Dulieu thì phải thay đổi như thế nào?

Bạn thử với Sub này xem:

Option Explicit

Sub sGpe()
Dim Dic As Object, sArr(), dArr(), I As Long, R As Long, K As Long
Set Dic = CreateObject("Scripting.Dictionary")
    sArr = Sheets("Dulieu").Range("A2", Sheets("Dulieu").Range("A1000000").End(xlUp)).Value2
    R = UBound(sArr)
ReDim dArr(1 To R, 1 To 2)
For I = 1 To R
    If sArr(I, 1) <> Empty Then
        If Not Dic.Exists(sArr(I, 1)) Then
            K = K + 1
            dArr(K, 1) = K
            dArr(K, 2) = sArr(I, 1)
            Dic.Item(sArr(I, 1)) = K
        End If
    End If
Next I
    Sheets("Ket qua").Range("A2:B1000000").ClearContents
    Sheets("Ket qua").Range("A2").Resize(K, 2) = dArr
Set Dic = Nothing
End Sub