EXCEL TOOLS
Excel Add-ins ที่พัฒนาโดยคุณสันติพงศ์ ณสุย (MVP Excel 2010-2020) ด้วยภาษา C# เพื่อแก้ไขปัญหาไฟล์ใหญ่ คำนวณนาน ทำงานช้า จัดการข้อมูลต่าง ๆ ที่ทำงานประจำวันได้อย่างสะดวกรวดเร็ว สนใจคลิกไปดูได้ที่นี่ครับ => Excel Tools
Excel Add-ins ที่พัฒนาโดยคุณสันติพงศ์ ณสุย (MVP Excel 2010-2020) ด้วยภาษา C# เพื่อแก้ไขปัญหาไฟล์ใหญ่ คำนวณนาน ทำงานช้า จัดการข้อมูลต่าง ๆ ที่ทำงานประจำวันได้อย่างสะดวกรวดเร็ว สนใจคลิกไปดูได้ที่นี่ครับ => Excel Tools
[code]
และปิดด้วย [/code]
ตัวอย่างเช่น [code]dim r as range[/code]
เพื่อให้แตกต่างจากข้อความทั่วไป สะดวกในการอ่านและทดสอบ (คลิกเพื่อดูตัวอย่าง)Code: Select all
Private Sub CommandButton1_Click()
Dim MyDict As Object, MyCols As Variant, OutCol As String, LastRow As Long
Dim InputSh As Worksheet, OutputSh As Worksheet
Dim x As Variant, i As Long, MyData As Variant
Set MyDict = CreateObject("Scripting.Dictionary")
Set InputSh = Sheets("Sheet1")
MyCols = Array("A", "B", "C", "D", "F")
Set OutputSh = Sheets("Sheet1")
OutCol = "H"
For Each x In MyCols
LastRow = InputSh.Cells(Rows.Count, x).End(xlUp).Row
MyData = InputSh.Range(x & "1:" & x & LastRow).Value
For i = 1 To UBound(MyData)
If MyData(i, 1) <> "" Then MyDict(MyData(i, 1)) = 1
Next i
Next x
OutputSh.Range(OutCol & "1").Resize(MyDict.Count, 1).Value = WorksheetFunction.Transpose(MyDict.keys)
'OutputSh.Range(OutCol & ":" & OutCol).ClearContents
Dim uniques As Collection
Dim OutputSh22 As Worksheet
Set uniques = Worksheets("Sheet1").Range("H2:H40")
Set OutputSh22 = Worksheets("Sheet1").Range("H2:H40")
Worksheets("Sheet1").Range("H2:H40").Sort
End Sub
กรุณาขยายความประโยคที่ผมระบายสีมาเพิ่มเติมว่าหมายถึงอะไร เขียนมาแล้วได้คำตอบหรือไม่ ติดขัดตรงไหน อย่างไรครับlotto009 wrote: Tue Jun 30, 2020 5:02 pm อ้างอิงค่าที่ไม่ซ้ำใน Colume "F" VS Colume "D") ใส่ค่าที่ไม่ซ้ำในคอลัมน์ "F" ไปยัง OUTPUT คอลัมน์ "H")
Code: Select all
Sub Button3_Click()
Dim arr(9999) As Variant, i As Long, j As Long
Dim d As Object, rAll As Range, r As Range, k As Long
Dim rAllSub As Range, arrU() As Variant
Dim s As String, u As Variant
Dim myCol As Variant
myCol = Array("d", "c", "b")
Set d = CreateObject("Scripting.Dictionary")
With Worksheets("Sheet1")
Set rAll = .Range("f2", .Range("f" & .Rows.Count).End(xlUp))
For Each r In rAll
s = CStr(r.Value)
If Not d.Exists(s) Then
d.Add Key:=s, Item:=s
End If
Next r
arrU = d.keys
For i = 0 To UBound(myCol)
Set rAllSub = .Range(myCol(i) & 2, .Range(myCol(i) & .Rows.Count) _
.End(xlUp))
For j = 0 To UBound(arrU)
If Application.CountIf(rAllSub, arrU(j)) = 0 Then
arr(k) = CLng(arrU(j))
k = k + 1
End If
Next j
Next i
If k > 0 Then
If .Range("h2").Value <> "" Then
.Range("h2", .Range("h" & .Rows.Count).End(xlUp)).ClearContents
End If
.Range("h2").Resize(k) = Application.Transpose(arr)
End If
End With
End Sub