转换成TXT

529905149

数据转换成TXT文件,谢谢。

529905149

sub dd()
Open ThisWorkbook.Path & "\data.txt" For Output As #1 '清空TXT内容
  For l = 7 To 100 '从第7行开始到100行
      If Cells(l, 1) <> "" Then '如果7行1列不为空，则运行下面的程序
      '如果7行1列和7行2列和7行3列不为空，则把他们连接输出到TXT
         If Cells(l, 1) <> "" And Cells(l, 2) <> "" And Cells(l, 3) <> "" Then Print #1, Cells(l, 1) & "、(" & Cells(l, 2) & ")" & Cells(l, 3)
         '如果7行4列不为空并且7行4列单元格颜色值等于46则输出到txt
         If Cells(l, 4) <> "" And Cells(l, 4).Interior.ColorIndex = 46 Then Print #1, "A、" & Cells(l, 4)
         If Cells(l, 5) <> "" And Cells(l, 5).Interior.ColorIndex = 46 Then Print #1, "B、" & Cells(l, 5)
         If Cells(l, 6) <> "" And Cells(l, 6).Interior.ColorIndex = 46 Then Print #1, "C、" & Cells(l, 6)
         If Cells(l, 7) <> "" And Cells(l, 7).Interior.ColorIndex = 46 Then Print #1, "D、" & Cells(l, 7)
         If Cells(l, 8) <> "" And Cells(l, 8).Interior.ColorIndex = 46 Then Print #1, "E、" & Cells(l, 8)
         If Cells(l, 9) <> "" And Cells(l, 9).Interior.ColorIndex = 46 Then Print #1, "F、" & Cells(l, 9)
         If Cells(l, 10) <> "" Then Print #1, "正确答案：" & Cells(l, 10)
         Print #1, Chr(10)  '输出结束后加一个换行符
      End If
   Next
   Close #1
end sub

529905149

Open ThisWorkbook.Path & "\data.txt" For Output As #1 '清空TXT内容
  For l = 7 To 100 '从第7行开始到100行
      If Cells(l, 1) <> "" Then '如果7行1列不为空，则运行下面的程序
      '如果7行1列和7行2列和7行3列不为空，则把他们连接输出到TXT
         If Cells(l, 1) <> "" And Cells(l, 2) <> "" And Cells(l, 3) <> "" Then Print #1, Cells(l, 1) & "、(" & Cells(l, 2) & ")" & Cells(l, 3)
         '如果7行4列不为空并且7行4列单元格颜色值等于46则输出到txt
         If Cells(l, 4) <> "" And Cells(l, 4).Interior.ColorIndex = 46 Then Print #1, "A、" & Cells(l, 4)
         If Cells(l, 5) <> "" And Cells(l, 5).Interior.ColorIndex = 46 Then Print #1, "B、" & Cells(l, 5)
         If Cells(l, 6) <> "" And Cells(l, 6).Interior.ColorIndex = 46 Then Print #1, "C、" & Cells(l, 6)
         If Cells(l, 7) <> "" And Cells(l, 7).Interior.ColorIndex = 46 Then Print #1, "D、" & Cells(l, 7)
         If Cells(l, 8) <> "" And Cells(l, 8).Interior.ColorIndex = 46 Then Print #1, "E、" & Cells(l, 8)
         If Cells(l, 9) <> "" And Cells(l, 9).Interior.ColorIndex = 46 Then Print #1, "F、" & Cells(l, 9)
         If Cells(l, 10) <> "" Then Print #1, "正确答案：" & Cells(l, 10)
         Print #1, Chr(10)  '输出结束后加一个换行符
      End If
   Next
   Close #1

Yalishanda30

试试看是不是可以了

529905149

Yalishanda30 发表于 2018-9-12 14:37
试试看是不是可以了

谢谢您的解答

一把小刀闯天下

Option Explicit

Sub test()
  Dim arr, i, j
  arr = Range("a6:j" & Cells(Rows.Count, "c").End(xlUp).Row)
  Open ThisWorkbook.Path & "\abc.txt" For Output As #1
  For i = 2 To UBound(arr, 1)
    Print #1, arr(i, 1) & "、" & "(" & arr(i, 2) & ")" & arr(i, 3)
    For j = 4 To UBound(arr, 2) - 1
      If Len(arr(i, j)) Then
        Print #1, Replace(arr(1, j), "选项", vbNullString) & "." & arr(i, j)
      End If
    Next
    Print #1, "正确答案：" & arr(i, j)
  Next
  Close #1
End Sub