宏迭代工作表的所有列中的所有行,并比较单元格以将行复制到文本文件

时间:2013-09-13 07:54:04

标签: excel vba excel-vba

我正在编写一个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

1 个答案:

答案 0 :(得分:1)

您可以使用Range对象的.Offset()方法和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

希望这会有所帮助:)