Question

我有Excel工作表对象，其中一些列处于不可见模式。我想将这些工作表保存为仅包含可见列的CSV文件。我的主要要求是不使用复制方法，而csv文件应包含值和格式的所有可见列。

Private Sub SaveAsCSV_TSA(ByVal xl As Excel.Application, ByVal xlsheet As Excel.Worksheet, ByVal CSVSavePath As String)

    On Error GoTo BottomLine

    Set xlwbook1 = xl.Workbooks.Add
    Dim xlsheet1 As Worksheet
    Set xlsheet1 = xlwbook1.Sheets.Item(1)
    xlsheet1.Activate

    xlsheet.Cells.SpecialCells(xlCellTypeVisible).Copy
    xlsheet1.Paste
    xl.CutCopyMode = False

    xlwbook1.SaveAs FileName:=CSVSavePath, FileFormat:=xlCSV
    xlwbook1.Close SaveChanges:=False
    Set xlwbook1 = Nothing
    Set xlsheet1 = Nothing

   BottomLine:
    If Not xlsheet1 Is Nothing Then Set xlsheet1 = Nothing
    If Not xlwbook1 Is Nothing Then Set xlwbook1 = Nothing
    If Err.number > 0 And Err.number <> cdlCancel Then
    MsgBox (Err.number & Chr(13) & Err.Description & " - Create_TS_Turn_file" & vbCrLf & "Line Number: " & Erl)
    End If
End Sub

在上面的例子中，xlsheet是一个源，xlsheet1是一个目的地。

注意：为什么我不需要使用复制命令。因为，我已经用不同的工作表作为参数反复调用上述方法（1000次）。（我遇到了问题，因为无法在此应用程序运行的计算机上执行其他复制/粘贴工作。这会导致用 xlsheet.Cells.SpecialCells（xlCellTypeVisible）替换原始复制的内容.Copy 内容。

请帮我解决这个问题..我需要尽快解决。提前致谢！

Answer 1

根据OP的进一步规范

已编辑

不太确定你的问题是什么，但也许这会有所帮助：

Option Explicit

Private Sub SaveAsCSV_TSA(ByVal xl As Excel.Application, ByVal xlsheet As Excel.Worksheet, ByVal CSVSavePath As String)
    Dim xlwbook1 As Workbook
    Dim xlsheet1 As Worksheet
    Dim cell As Range
    Dim colsAddr As String

    On Error GoTo BottomLine

    Set xlwbook1 = xl.Workbooks.Add
    With xlwbook1
        xlsheet.Copy After:=.Sheets.Item(1)

        With .ActiveSheet '<~~ here starts the new "treatment"
            With .UsedRange
                For Each cell In .Rows(1).Cells '<~~ loop through first row cells
                    If cell.EntireColumn.Hidden Then colsAddr = colsAddr & cell.EntireColumn.Address & "," '<~~ store cell entire column address if hidden
                Next cell
                .Value = .Value '<~~ get rid of formulas and keep only their resulting values
            End With
            If colsAddr <> "" Then .Range(Left(colsAddr, Len(colsAddr) - 1)).Delete '<~~ delete hidden columns, if any
        End With '<~~ here ends the new "treatment"

        .SaveAs Filename:=CSVSavePath, FileFormat:=xlCSV
        .Close SaveChanges:=False
    End With
    Set xlwbook1 = Nothing
    Set xlsheet1 = Nothing

BottomLine:
    If Not xlsheet1 Is Nothing Then Set xlsheet1 = Nothing
    If Not xlwbook1 Is Nothing Then Set xlwbook1 = Nothing
    If Err.Number > 0 And Err.Number <> xlCancel Then
      MsgBox (Err.Number & Chr(13) & Err.Description & " - Create_TS_Turn_file" & vbCrLf & "Line Number: " & Erl)
    End If
End Sub

我建议称之为

Sub main()

    Application.ScreenUpdating = False '<~~ stop screen updating and speed things up
    SaveAsCSV_TSA Application, ActiveSheet, "yourpath"
    Application.ScreenUpdating = True '<~~ resume  screen updating

End Sub

仅使用Excel工作表将可见列复制为VB6中的CSV文件，而不使用复制命令

1 个答案: