将表格复制到具有特定模板的文本文件会跳过偶数

时间:2016-07-20 13:22:31

标签: excel excel-vba export text-files vba

我想用特定的模板将工作表复制到文本文件,我定义了一个范围,但问题是它跳过偶数,这意味着行A2,A4,A6 ......没有被复制 所以它在结果空白行

结尾
Option Explicit

 Sub txtFile()

  Dim strPath As String
  Dim fso As Object
  Dim ts As Object

   Dim wsDest As Worksheet
   Set wsDest = Sheets("Filter FS")
   wsDest.Select
  Set fso = CreateObject("Scripting.FileSystemObject")

  Dim cellAimsID As Variant
  Dim cellAmount As Variant
  Dim cellCurrencyISO As Variant
  Dim cellReason As Variant
  Dim cellExpiryDate As Variant
  Dim FirstRow As String
  Dim LastRow As String

  Dim a As Range, b As Range, cell As String, rng As Range
  Set a = Selection
  Set ts = fso.CreateTextFile("C:\Users\cben\Documents\BKC\FinancialSecurity\test13.txt", True, True)
  ' for each cell in the worksheet create a line in text fil
 FirstRow = wsDest.UsedRange.Rows(1).Row
 LastRow = wsDest.Range("A" & Rows.Count).End(xlUp).Row
 Set rng = wsDest.Range("A2:A" & LastRow)
 'Set rng = wsDest.Range("A1:A5")
  For Each a In rng
    cellAimsID = a.Cells(a.Row, 1)
    cellAmount = a.Cells(a.Row, 2)
    cellCurrencyISO = a.Cells(a.Row, 3)
    cellReason = a.Cells(a.Row, 4)
    cellExpiryDate = a.Cells(a.Row, 5)

    'AimsID, Amount, Currency, Reason, ExpiryDate are the name of columns in worksheet
      ts.WriteLine (Chr(9) & "cases" & ": [")
      ts.WriteLine (Chr(9) & "{")
      ts.WriteLine (Chr(9) & "AimsID:" & cellAimsID & ",")
      ts.WriteLine (Chr(9) & "Amount:" & cellAmount & ",")
      ts.WriteLine (Chr(9) & "CurrencyISO:" & cellCurrencyISO & ",")
      ts.WriteLine (Chr(9) & "Reason:" & cellReason & ",")
      ts.WriteLine (Chr(9) & "ExpiryDate:" & cellExpiryDate & ",")
      ts.WriteLine (Chr(9) & "}" & ",")

  Next
 ts.Close

End Sub

这是结果

enter image description here

例如AimsID = 69210794对应A41下一个AimsID = 86917526对应A43而不是结果中的A42

2 个答案:

答案 0 :(得分:0)

问题在于您的For Each循环,详情如下。

  For Each a In rng
    cellAimsID = a.Cells(a.Row, 1)
    cellAmount = a.Cells(a.Row, 2)
    cellCurrencyISO = a.Cells(a.Row, 3)
    cellReason = a.Cells(a.Row, 4)
    cellExpiryDate = a.Cells(a.Row, 5)

在此循环中,变量a引用Range对象。然而,在循环内部,您为每个变量分配Range对象的Range属性。让我们仔细看看它的例子:

`cellAimsID = a.Cells(a.Row, 1)

假设您处于循环的第二次迭代,变量a指的是单元格A3。上面的语法是cellsAimsID = Range("A3").Range("A3")。将Range属性应用于Range对象时会发生什么?它基本上抵消了细胞。在上面的示例中,单元格指针基本上移动到一个单元格,该单元格将成为A列中的第三个单元格,如果范围以A3开头。

我知道这听起来有点令人困惑,但如果您有疑问,请跟进。

要修复错误,请将语法替换为(请注意我删除了a限定符):

cellAimsID = Cells(a.Row, 1)
cellAimsID = Cells(a.Row, 1)

作为旁注,最好使用工作表名称完全限定范围,以防宏在不同的工作表上进行处理。因此将代码更改为甚至更好:

cellAimsID = wsDest.Cells(a.Row, 1)
cellAimsID = wsDest.Cells(a.Row, 1)

答案 1 :(得分:0)

这是我更改后的代码, 它允许使用特定模板在文本文件中导出工作表。 PS:最后一行有一个关闭数组,所以我在范围之外做了。

 Option Explicit

 Sub txtFile()

  Dim strPath As String
  Dim fso As Object
  Dim ts As Object

   Dim wsDest As Worksheet
   Set wsDest = Sheets("Filter FS")
   wsDest.Select
  Set fso = CreateObject("Scripting.FileSystemObject")

  Dim cellAimsID As Variant
  Dim cellAmount As Variant
  Dim cellCurrencyISO As Variant
  Dim cellReason As Variant
  Dim cellExpiryDate As Variant
  Dim FirstRow As String
  Dim LastRow As String
  Dim LastRowB As String
  Dim a As Range, b As Range, cell As String, rng As Range, Lastrng As Range
  Set a = Selection
  Set ts = fso.CreateTextFile("C:\Users\cben\Documents\BKC\FinancialSecurity\test20.txt", True, True)
  ' for each cell in the worksheet create a line in text fil
 FirstRow = wsDest.UsedRange.Rows(1).Row
 LastRow = wsDest.Range("A" & Rows.Count).End(xlUp).Row
 LastRowB = (wsDest.Range("A" & Rows.Count).End(xlUp).Row) - 1
 Set rng = wsDest.Range("A2:A" & LastRowB)
 Set Lastrng = wsDest.Range("A" & LastRow)
  ts.WriteLine ("{")
  ts.WriteLine (Chr(9) & "“cases”" & ": [")
  For Each a In rng
cellAimsID = Cells(a.Row, 1)
cellCurrencyISO = Cells(a.Row, 2)
cellAmount = Cells(a.Row, 3)
cellReason = Cells(a.Row, 4)
cellExpiryDate = Cells(a.Row, 5)

'AimsID, Amount, Currency, Reason, ExpiryDate are the name of columns in worksheet

  ts.WriteLine (Chr(9) & "{")
  ts.WriteLine (Chr(9) & "“AimsID”" & ":" & Chr(9) & cellAimsID & ",")
  ts.WriteLine (Chr(9) & "“Amount”" & ":" & Chr(9) & cellAmount & ",")
  ts.WriteLine (Chr(9) & "“CurrencyISO”" & ":" & Chr(9) & cellCurrencyISO & ",")
  ts.WriteLine (Chr(9) & "“Reason”" & ":" & Chr(9) & cellReason & ",")
  ts.WriteLine (Chr(9) & "“ExpiryDate”" & ":" & Chr(9) & "“" & cellExpiryDate & "”")
  ts.WriteLine (Chr(9) & "}" & ",")

  Next

cellAimsID = Cells(LastRow, 1)
cellCurrencyISO = Cells(LastRow, 2)
cellAmount = Cells(LastRow, 3)
cellReason = Cells(LastRow, 4)
cellExpiryDate = Cells(LastRow, 5)

  ts.WriteLine (Chr(9) & "{")
  ts.WriteLine (Chr(9) & "“AimsID”" & ":" & Chr(9) & cellAimsID & ",")
  ts.WriteLine (Chr(9) & "“Amount”" & ":" & Chr(9) & cellAmount & ",")
  ts.WriteLine (Chr(9) & "“CurrencyISO”" & ":" & Chr(9) & cellCurrencyISO & ",")
  ts.WriteLine (Chr(9) & "“Reason”" & ":" & Chr(9) & cellReason & ",")
  ts.WriteLine (Chr(9) & "“ExpiryDate”" & ":" & Chr(9) & "“" & cellExpiryDate & "”")
  ts.WriteLine (Chr(9) & "}" & "]")
  ts.WriteLine ("}")
 ts.Close

End Sub