我已经浏览了整个论坛，找不到具体的代码来完成这个（只有可能放在一起的代码片段可以做我想要的）。
是否可以执行以下操作：
我想用“写入”或“打印”执行此操作，而不是简单地复制到剪贴板并粘贴。
请参阅下面的代码。它过滤并复制/粘贴到所需的文本文件，但它在第一个过滤的单元格停止，即有5行＆＃34; R / R＆＃34;在B栏（571,4213,4510,5191,5192）中，但它仅粘贴细胞P571。
Sub abc（）
Sheets("Test1").ListObjects("Table_Query_from_MS_Access_Database").Range. _
AutoFilter Field:=2, Criteria1:="R/R"
LastRow = Sheets("Test1").Range("P" & Rows.Count).End(xlUp).Row
Dim filename As String, lineText As String
Dim myrng As Range, i, j
filename = "C:\Users\bob\Desktop\output.txt"
Open filename For Output As #1
Set myrng = Sheets("Test1").Range("P2:P" & LastRow).SpecialCells(xlCellTypeVisible)
For i = 1 To myrng.Rows.Count
For j = 1 To myrng.Columns.Count
lineText = IIf(j = 1, "", lineText & ",") & myrng.Cells(i, j)
Next j
Print #1, lineText
Next i
Close #1
End Sub
编辑：用户提供的代码最初有效，但似乎有一个错误。 每当有＆＃34; R / R＆＃34;在另一行（例如Cell B122＆amp; B123）之后的一行中，它粘贴来自Cell P122＆amp;的数据。用逗号一个接一个地将P123添加到文本文件中，而不是将其移动到文本文件中的下一行，这就是我想要的。 我希望它粘贴到下面的文本文件中（请忽略破折号＆＃34; - ＆＃34;，我需要将它们放在此线程中的另一行＃）
然而，它正在粘贴它，其中一条线上有一个逗号并将其放在另一个数字旁边：
答案 0 :(得分：1)
您必须遍历范围Areas集合
你可以尝试这个（评论过的）代码：
Option Explicit
Sub main()
Dim myRng As Range
Dim arr As Variant
With Sheets("Test1") '<--| reference relevant sheet
With .ListObjects("Table_Query_from_MS_Access_Database").Range '<--| reference its relevant Table
.AutoFilter Field:=2, Criteria1:="R/R" '<--| filter it on its 2nd column (column "B" if table starts from column "A"
If Application.WorksheetFunction.Subtotal(103, .Resize(, 1)) > 1 Then Set myRng = .Offset(1).Resize(.rows.Count - 1).SpecialCells(xlCellTypeVisible) 'set filtered range, if any, 1st row (headers) excluded
End With
.AutoFilterMode = False '<--| get rows back visible
End With
If Not myRng Is Nothing Then WriteFile "C:\Users\bob\Desktop\output.txt", myRng '<--| write txt file if any filtered Table rows
End Sub
Sub WriteFile(filePath As String, rng As Range)
Dim i As Long
Dim area As Range
On Error GoTo ExitSub '<--| be sure to properly close txt file
Open filePath For Output As #1
For Each area In rng.Areas '<--| loop through range 'Areas' collection
For i = 1 To area.rows.Count '<--| loop through current 'area' rows
Print #1, Join(Application.Transpose(Application.Transpose(area.rows(i).Value)), ",") '<--|collect current Table row cells into an array and then join its content into a string with comma (",") as separator
Next i
Next area
ExitSub:
Close #1
End Sub
仅适用于P列：
在OP的澄清之后编辑
Option Explicit
Sub main()
Dim myRng As Range
Dim arr As Variant
With Sheets("Test1") '<--| reference relevant sheet
With .ListObjects("Table_Query_from_MS_Access_Database").Range '<--| reference its relevant Table
.AutoFilter Field:=2, Criteria1:="R/R" '<--| filter it on its 2nd column (column "B" if table starts from column "A"
If Application.WorksheetFunction.Subtotal(103, .Resize(, 1)) > 1 Then Set myRng = .Offset(1, 15).Resize(.rows.Count - 1, 1).SpecialCells(xlCellTypeVisible) 'set filtered range, if any, 1st row (headers) excluded
End With
.AutoFilterMode = False '<--| get rows back visible
End With
If Not myRng Is Nothing Then WriteFile "C:\Users\bob\Desktop\output.txt", myRng '<--| write txt file if any filtered Table rows
End Sub
Sub WriteFile(filePath As String, rng As Range)
Dim i As Long
Dim area As Range
Dim lineText As String
On Error GoTo ExitSub '<--| be sure to properly close txt file
Open filePath For Output As #1
For Each area In rng.Areas '<--| loop through range 'Areas' collection
For i = 1 To area.rows.Count '<--| loop through current 'area' rows
lineText = IIf(i = 1, "", lineText & vbCrLf) & area(i, 1).Value
Next i
Print #1, lineText
Next area
ExitSub:
Close #1
End Sub