ซับรูทีน สำหรับกรองข้อมูล

ซับรูทีน สำหรับกรองข้อมูล


Sub check2()
Dim dataOutput As New Collection
Dim Data4000 As Range
Dim Data3000 As Range
Dim SaveFlag As Boolean
Dim Num4000 As Integer
Dim Num3000 As Integer
Dim i As Integer, j As Integer
Dim ID1, ID2
Dim ID, Prename, fName, LName, Sex, age, add, moo, HospSub
Dim array1
Dim str1 As String


On Error Resume Next

Set Data4000 = Worksheets("Q_pop35").Range("A2:A4346")
Set Data3000 = Worksheets("SumDataSheet").Range("B2:E3211")

Num4000 = Data4000.Rows.Count
Num3000 = Data3000.Rows.Count


Debug.Print "Num4000 = ", Num4000
Debug.Print "Num3000 = ", Num3000

For i = 1 To Num4000
'For i = 1 To 100
ID1 = Trim(Data4000.Cells(i, 1))
SaveFlag = True

'Debug.Print "Check : ", i, " : ", ID1

For j = 1 To Num3000
'For j = 1 To 100
ID2 = Trim(Data3000.Cells(j, 1))
If StrComp(ID1, ID2) = 0 Then
SaveFlag = False
Exit For
End If
Next

If SaveFlag Then
ID = Data4000.Cells(i, 1)
Prename = Data4000.Cells(i, 2)
fName = Data4000.Cells(i, 3)
LName = Data4000.Cells(i, 4)
Sex = Data4000.Cells(i, 5)
age = Data4000.Cells(i, 6)
add = Data4000.Cells(i, 7)
moo = Data4000.Cells(i, 8)
HospSub = Data4000.Cells(i, 9)
array1 = Array(ID, Prename, fName, LName, Sex, age, add, moo, HospSub)
str1 = Join(array1, ",")
dataOutput.add str1, ID
Debug.Print "Save Data #" & dataOutput.Count
End If

Next



fName = ThisWorkbook.Path & "\" & "DataOutput.txt"
Open fName For Output As #1
For i = 1 To dataOutput.Count
Print #1, dataOutput.Item(i)
Next
Close #1

Debug.Print "Finish"

End Sub