如何迭代特定列？

Question

我有一個Excel表，其中列A我有整數值。
我不知道我有多少個值。
我不知道每個值之間是否有空格。
有值重複。

A 
-------- 
1| 76 
2| 56 
3| 34 
4| ---- 
5| 9 
6| 9 
.| --- 
.| --- 
.| 56 

我需要在文件.txt上寫入所有沒有重複的值。

我如何在VBA中編寫代碼？

Answer 1

像這樣的東西應該讓你在那裏。

在你的VBA IDE中，進入工具菜單並選擇參考。爲ADODB記錄集選擇「Microstoft ActiveX數據對象2.8庫」。

在你的VBA IDE中，進入工具菜單並選擇參考。爲您的文件輸出選擇「Microsoft腳本運行時」。

Private Sub CommandButton1_Click() 

    Dim rs As New ADODB.Recordset 
    Dim ws As Excel.Worksheet 
    Set ws = ActiveWorkbook.Sheets("Sheet1") 
    Dim lastRow As Long 
    Dim lRow As Long 
    Dim ts As TextStream 
    Dim fs As FileSystemObject 

    'Create the text file to write to 
    Set fs = New FileSystemObject 
    Set ts = fs.CreateTextFile("C:\Temp\test.txt", True, False) 

    'Add fields to your recordset for storing data. 
    With rs 
     .Fields.Append "Value", adChar, 25 
     .Open 
    End With 

    'This is getting the last used row in column A 
    lastRow = ws.Cells(ws.Rows.count, "A").End(xlUp).Row 

    'Loop through the rows 
    lRow = 1 
    Do While lRow <= lastRow 

     'Check if this is already data that we are counting 
     rs.Filter = "" 
     rs.Filter = "Value='" & ws.Range("A" & lRow).Value & "'" 

     If rs.RecordCount = 0 Then 
      'If this is a new value, add a new row for it 
      rs.AddNew 
      rs.Fields("Value").Value = ws.Range("A" & lRow).Value 
      rs.Fields("Count").Value = 1 
      rs.Update 
     End If 

    lRow = lRow + 1 
    Loop 

    'Remove the filer and move to the first record in the rs 
    rs.Filter = "" 
    rs.MoveFirst 

    'Loop through the data we found and write it out 
    Do While rs.EOF = False 
     ts.WriteLine ws.Cells(rs.Fields("Value").Value) 
    rs.MoveNext 
    Loop 

    'Clean up 
    ts.Close: Set ts = Nothing 
    Set fs = Nothing 

End Sub 

Answer 2

下面是使用Dictionary得到不同的值爲例，Join()使結果文本，並FileSystemObject的文本保存到一個文件：

Sub WriteDistinctToFile() 

    Dim rngSource As Range 
    Dim varItem As Variant 
    Dim arrDistinct() As Variant 

    With ActiveWorkbook.Sheets("Sheet1") 
     Set rngSource = Intersect(.UsedRange, .Columns(1)) ' only used cells in first column 
    End With 
    With CreateObject("Scripting.Dictionary") 
     .Item("") = "" ' add empty key to remove it later 
     For Each varItem In rngSource.Value 
      .Item(varItem) = "" ' add each cell value to unique keys 
     Next 
     .Remove "" ' remove empty value 
     arrDistinct = .Keys() ' convert to array 
    End With 
    With CreateObject("Scripting.FileSystemObject").OpenTextFile("C:\Test.txt", 2, True, 0) ' open text file for output in ASCII 
     .Write Join(arrDistinct, vbCrLf) ' join values from array into new line separated string, then write to file 
     .Close 
    End With 

End Sub