Warning: file_get_contents(/data/phpspider/zhask/data//catemap/6/apache/9.json): failed to open stream: No such file or directory in /data/phpspider/zhask/libs/function.php on line 167

Warning: Invalid argument supplied for foreach() in /data/phpspider/zhask/libs/tag.function.php on line 1116

Notice: Undefined index: in /data/phpspider/zhask/libs/function.php on line 180

Warning: array_chunk() expects parameter 1 to be array, null given in /data/phpspider/zhask/libs/function.php on line 181
Excel 将使用范围复制到文本文件_Excel_Vba_Copy_Range - Fatal编程技术网

Excel 将使用范围复制到文本文件

Excel 将使用范围复制到文本文件,excel,vba,copy,range,Excel,Vba,Copy,Range,我想: 复制名为“Kommentar”的工作表的使用范围 在与此工作簿相同的目录中创建“.txt”文件(“Kommentar.txt”) 粘贴以前复制的使用范围 保存“.txt”文件 我有: Sub CreateAfile() Dim pth As String pth = ThisWorkbook.path Dim fs As Object Set fs = CreateObject("Scripting.FileSystemObject") Dim a As Object Set a

我想:

  • 复制名为“Kommentar”的工作表的使用范围
  • 在与此工作簿相同的目录中创建“.txt”文件(“Kommentar.txt”)
  • 粘贴以前复制的使用范围
  • 保存“.txt”文件
我有:

Sub CreateAfile()

Dim pth As String
pth = ThisWorkbook.path
Dim fs As Object
Set fs = CreateObject("Scripting.FileSystemObject")
Dim a As Object
Set a = fs.CreateTextFile(pth & "\Kommentar.txt", True)
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Kommentar")

Dim rng As Range
Set rng = sh.UsedRange
a.WriteLine (rng)
a.Close

End Sub
我明白了

运行时错误“13”不匹配


在第
a.WriteLine(rng)
行中,函数不接受要写入的范围。

由于您的范围可能由多个单元格组成,因此您必须循环它们以将所有文本放入字符串变量中。如果使用变量,则可以复制值并自动获取单元格中所有数据的正确尺寸的数组,然后循环该数组并复制文本:

Function GetTextFromRangeText(ByVal poRange As Range) As String
    Dim vRange As Variant
    Dim sRet As String
    Dim i As Integer
    Dim j As Integer

    If Not poRange Is Nothing Then

        vRange = poRange

        For i = LBound(vRange) To UBound(vRange)
            For j = LBound(vRange, 2) To UBound(vRange, 2)
                sRet = sRet & vRange(i, j)
            Next j
            sRet = sRet & vbCrLf
        Next i
    End If

    GetTextFromRangeText = sRet
End Function
通过将
a.WriteLine(rng)
行替换为以下内容来调用代码中的函数:

Dim sRange As String
sRange = GetTextFromRangeText(rng)
Call a.WriteLine(sRange)

我不确定你能做到。我相信你得一行一行地写出来。

这里有另一个选择。
您可以尝试将工作表保存为.txt文件,而不是使用FSO。 下面是一些示例代码。 信用卡应该转帐


假设
yourRange
是要复制为字符串的范围

  • 使用
    yourRange
    。复制它
  • 复制后,Excel将文本值保存到剪贴板。以制表符分隔的行中的单元格,每行以enter结束。可以使用DataObject的
    GetFromClipboard
    GetText
    方法将其保存到字符串变量中
  • 使用
    CreateTextFile
    将其保存到文件中

  • Writeln带有字符串参数..,必须逐个单元格获取值
    Option Explicit
    
    'Copy the contents of a worksheet, and save it as a new workbook as a .txt file
    Sub Kommentar_Tab()
    Dim wbSource As Workbook
    Dim wsSource As Worksheet
    Dim wbDest As Workbook
    Dim fName As String
    
    'References
    Set wbSource = ActiveWorkbook
    Set wsSource = ThisWorkbook.Sheets("Kommentar")
    Set wbDest = Workbooks.Add
    
    'Copy range on original sheet
    'Using usedrange can be risky and may return the wrong result.
    wsSource.UsedRange.Copy
    
    'Save in new workbook
    wbDest.Worksheets(1).Cells(1, 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
    Application.CutCopyMode = False
    
    'Get file name and location
    fName = ThisWorkbook.Path & "\Kommentar.txt"
    
    'Save new tab delimited file
    wbDest.SaveAs fName, xlText
    
    wbDest.Close SaveChanges:=True
    
    End Sub