vba - 用于遍历工作表所有列中的所有行并比较单元格以将行复制到文本文件的宏

Question

我正在编写一个 VB excel 宏，它遍历打开的工作簿中的所有工作表。
在每个工作表中，K 列中存储的“Y”很少。我想将 K 列中的值与“Y”进行比较，如果相等，则同一行的 A、B、D、H 列应该得到以制表符分隔的格式插入文本文件。

这是我尝试过的代码。在此代码中，我仅将 K 列插入到文本文件中。但我还想将 A、B、D、H 和 K 列值的值插入到由制表符分隔的文本文件中。

请帮帮我。

我试过的代码是

  Sub Button3_Click()
  Dim fso, myfile, I As Integer, mycount As String, x As String
  Dim curCell As Range
  Dim sh As Worksheet 
  x = "Y"
  Set fso = CreateObject("Scripting.FileSystemObject")
  Set myfile = fso.CreateTextFile("d:\RECP_IMP_COLUMNS.txt", True)
  myfile.WriteLine ("Work Sheet Names are as follows")


    For Each sh In ActiveWorkbook.Worksheets

      For Each curCell In Sheet4.Range("K1:K300").Cells
       If (curCell.Value = x) Then
        myfile.WriteLine (curCell)
       End If
      Next curCell

    Next

    myfile.Close
  End Sub

Answer 1

您可以使用 .Offset() Range对象和vbTab的方法常量来创建制表符分隔的空格
.Offset(rows, columns)接受2个参数。当前单元格向上或向下的行数。要向上导航，您给它一个负值以向下一个正值。这同样适用于列，除了您使用负数向左移动和正数向右移动。
vbTab在上下文中的两个对象之间创建一个选项卡

"this is " & vbtab & " tab delimited"

我稍微修改了您的比较方法并添加了 StrComp() function .它更可靠，您可以指定比较参数。

请看 how to compare strings in VBA有关 = 的更多详细信息字符串比较中的运算符。

我已更改您的 Sheet4.Range("K1:K300")因为这有点误导和错误。您循环遍历所有工作表，但只使用了 Sheet4对于每个循环。因此，您在文本文件中打印的所有结果都将与 Sheet4 重复。 K 列。
_行尾的下划线将代码拆分为更多行，以便您可以挤入更多行并使代码更具可读性和清晰性。

Sub Button3_Click()
    Dim fso, myfile, I As Integer, mycount As String, x As String
    Dim curCell As Range
    Dim sh As Worksheet
    x = "Y"
    Set fso = CreateObject("Scripting.FileSystemObject")

    Set myfile = fso.CreateTextFile("d:\RECP_IMP_COLUMNS.txt", True)
    myfile.WriteLine ("Work Sheet Names are as follows")

    For Each sh In ActiveWorkbook.Worksheets
        For Each curCell In sh.Range("K1:K300").Cells
            If StrComp(curCell, x, vbTextCompare) = 0 Then
            myfile.WriteLine curCell.Offset(0, -10) & vbTab & _
                           curCell.Offset(0, -9) & vbTab & _
                           curCell.Offset(0, -7) & vbTab & _
                           curCell.Offset(0, -3) & vbTab & _
                           curCell
            End If
        Next curCell
    Next

    myfile.Close
End Sub

希望这可以帮助 :)