时间戳

首页 > 解决方案 > 使用当前工作表中的特定数据导出 CSV（选择正确数据的问题）

vba - 使用当前工作表中的特定数据导出 CSV（选择正确数据的问题）

问题描述

我想知道是否有人可以帮助我解决这个问题；我有一张大桌子。对于 F 列中满足条件的所有行（值必须为 89），我想选择 A、H 和 I 列中的相应行。然后我想将这些行导出为 csv 文件, 如果文件已经存在，则必须覆盖该文件。例如，假设我的桌子看起来像；

F    A   B   C   H   I
89   45  4   3   6   2
43   23  4   5   4   2
89   3   6   5   65  7
22   43  6   6   2   4
89   56  9   9   35  2

因此，在 F 列中有 3 行满足条件，并且对应的 A、H 和 I 列的行具有值 (45, 6, 2), (3, 65, 7) 和 (56, 35, 2)我希望我导出的文件看起来像这样；

**A   H   I**
  45  6   2
  3   65  7
  56  35  2

我有两件事有问题：

  1. 能够仅选择三个所需列中相同行的特定单元格。我在互联网上找到的大多数帮助仅适用于选择 1 个特定单元格或整个列。鉴于我不知道 F 列中的哪些行将满足条件，我无法手动选择 A、H 和 I 列中的相应单元格，因为我不知道行号。
  2. 我导出的文件无法正常工作；它要么无法覆盖（代码1），要么在我运行代码时不断覆盖并打开新工作簿（代码2）

我已经来回尝试了一段时间，并通过互联网搜索任何可能有帮助的东西，但我无法让它发挥作用。到目前为止，我有 2 个不同的代码，我一直在尝试制作它们，但它们都没有。第一个代码是：

Private Sub CommandButton1_Click()
Dim TransferExport As Integer
Dim u As Integer  
Dim x As Integer
Dim y As Integer
Dim data As String
For i = 2 To 18288
If Sheets("Base").Cells(i, 6).Value = "89" Then
u = Sheets("Base").Cells(i, 1).Value
If Sheets("Base").Cells(i, 6).Value = "89" Then
x = Sheets("Base").Cells(i, 8).Value
If Sheets("Base").Cells(i, 6).Value = "89" Then
y = Sheets("Base").Cells(i, 9).Value
End If
End If
End If

TransferExport = FreeFile
data = data & Sheets("Base").Cells(1, 1) & u & " ; "
data = data & Sheets("Base").Cells(1, 8) & x & " ; "
data = data & Sheets("Base").Cells(1, 9) & y & " ; "
Open "C:\Users\bruger1\Documents\Uni\TransferExport.csv" For Append As 
#TransferExport
    Print #TransferExport, u, x, y
Close #TransferExport

Next
MsgBox "Your file has been exported"

End Sub

^这是我的第一个代码。请注意，我知道对于 u、x 和 y 的“If-Then”选择，我选择了整个列，这当然不是我想要的，但我找不到一种方法让它只选择对应的行。虽然它确实运行，但它不能完全运行，因为行数太多（18288）并且它确实设法拉出的行都简单地说“0”，也没有像我指定的那样拉出每一列的第一行数据字符串（第一行是列名）。我试着这样做；

Dim rw As Range
Set rw = Sheets("Base").Range("F:F")
For i = 2 To 18288

If rw = "89" Then
u = Sheets("Base").Cells(rw, 1).Value

但这行不通。这段代码的另一个问题是，如果文件已经存在，它不会覆盖文件，而是拒绝运行。

我尝试过的第二个代码是；

Private Sub CommandButton1_Click()

Dim rng As Range
Dim cell As Range
Dim data As String

Set rng = Range("F2:F18288")

For Each cell In rng
    If cell.Value = "89" Then
        Sheets("Base").Cells(cell, "A").Select
        Sheets("Base").Cells(cell, "H").Select
        Sheets("Base").Cells(cell, "I").Select
        End If

 Selection.Copy
 data = "C:\Users\bruger1\Documents\Uni\TransferExport.csv"
Workbooks.Add
ActiveSheet.Paste
ActiveWorkbook.SaveAs Filename:=data, _
FileFormat:=xlCSV, CreateBackup:=False, local:=True
Application.DisplayAlerts = False
ActiveWorkbook.Close
Application.DisplayAlerts = True

Next
MsgBox "Your file has been exported"

End Sub

我对此有几个问题；首先，当我单击命令按钮时，每次单击它都会做不同的事情？有时它会不断询问我是否要覆盖现有文件，并打开一个新文档。每次我单击“是”时，它都会打开一个新文档并立即问我同样的问题。如果我单击否或取消它会给我一个运行时错误“1004”。有时它会导出文件，但也会从我的表中打开一个带有随机值的新工作簿，我没有尝试将其拉出？同时，实际导出的文件“TransferExport”只是在单元格 A1 中写入了单个数字“1”。

如前所述，我一直在尝试在互联网上找到任何帮助，但到目前为止没有任何帮助。任何帮助将不胜感激。

标签： vbaexcel

解决方案

试试这个，请阅读评论并尝试理解代码中发生的一切，随时提出问题：

Private Sub CommandButton1_Click()
    Dim data As String, lastRow As Long, i As Long
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.Calculation = xlCalculationManual
    Set wk = ThisWorkbook
    'New Workbook
    Workbooks.Add
    Set awk = ActiveWorkbook
    'Copy all data to new Workbook
    wk.Sheets("Base").Columns("A:F").Copy
    awk.Worksheets(1).Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    'Find the lastRow in this data based on Column F (6)
    lastRow = awk.Worksheets(1).Cells(Excel.Rows.Count, 6).End(Excel.xlUp).Row
    'Loop and Remove any Row where F is NOT "89"
    For i = lastRow To 1 Step -1
        If awk.Worksheets(1).Cells(i, 6).Value <> "89" Then
            awk.Worksheets(1).Cells(i, 6).EntireRow.Delete
        End If
    Next
    'Delete columns we dont want
    awk.Worksheets(1).Columns("B:G").Delete Shift:=xlToLeft
    'Save/Ovewrite It, Close it.
    data = "C:\Users\bruger1\Documents\Uni\TransferExport.csv"
    awk.SaveAs Filename:=data, FileFormat:=xlCSV, AccessMode:=xlExclusive, _
        ConflictResolution:=Excel.XlSaveConflictResolution.xlLocalSessionChanges
    Application.Calculation = xlCalculationAutomatic
    awk.Close
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    MsgBox "Your file has been exported"
End Sub

推荐阅读