满足条件时创建以单元格命名的新文本文件

Question

到目前为止，我已经查看并找到了一些帮助，但我正在为我正在尝试制作的这个 Excel 宏的每个逻辑而苦苦挣扎。

基本上我有 4 列数据。 A 列具有某事物的名称，D 列具有 TRUE 或 FALSE。

我想要一个连接到按钮的宏，该按钮在给定目录中创建一个新文本文件，该目录以 Col A 的内容命名，但前提是该行中的 Col D 标记为“TRUE”。

例如，如果我有以下情况。

ColA = 测试 ColD = TRUE

ColA = Test2 ColD = FALSE

ColA = Test3 ColD = TRUE

我会得到 2 个文本文件，分别是 Test.txt 和 Test3.txt。

我知道我需要一个 for 每个循环来查看 a1-d 的范围（无论数字），然后当 D = True 时执行 SaveAs 我猜？？

这是我到目前为止的代码（是的，我知道它非常不完整，但这是我在碰壁之前的逻辑）。

Dim fileName As String
Dim filePath As String
Dim curCell As Object
Dim hideRange As Range

filePath = "C:\ExcelTest\"
hideRange = Range("D1:D1048576")
fileName = *Content of Cell A from this Row*

For Each Row In Range("A1:D1048576")
    IF curCell.value In Range hideRange = "TRUE"
      Then curCell.SaveAs fileName & ".txt, xlTextWindows

任何帮助甚至为我指明正确的方向都会很棒。我搜索了一些示例，但找不到任何与我想要做的真正匹配的东西。

Answer 1

你已经很接近了，但你在那里循环了一大堆细胞。

这是循环行的代码，它在列中最后一个填充的单元格处停止。

Sub LoopRows()

dim sht as worksheet
set sht = Thisworkbook.Sheets("Name of Worksheet")

'loop from row 1 to the last row containing data
For i = 1 To sht.Range("A:A").End(xlDown).Row
    'check the value in column 4 for this row (i)
    If sht.Cells(i, 4).Text = "TRUE" Then
        CreateFile sht.Cells(i, 1).Value
    End If
Next i

End Sub

为了编写文件，为了简单起见，它将引用 Microsoft 脚本运行时并按如下方式执行：

Sub CreateFile(FileName As String)
    Dim fso As New FileSystemObject
    fso.CreateTextFile "c:\temp\" & FileName & ".txt", True
End Sub

编辑 我不明白你为什么没有创建文件，我的测试在 Windows 机器上对我来说很好。

您能否在按钮中单独尝试以下代码，看看它是否打开了一个文本文件？

Dim fso As New FileSystemObject
fso.CreateTextFile "c:\temp\testfso.txt"
Shell "C:\WINDOWS\notepad.exe c:\temp\testfso.txt", vbMaximizedFocus

编辑 2

试试这个，看看它是否打开了文本文件..

Sub CreateFile(FileName As String)
    Dim fso As New FileSystemObject
    Dim fName as String
    fName = "c:\temp\" & FileName & ".txt"
    fso.CreateTextFile fName, True
    Shell "C:\WINDOWS\notepad.exe " & fName, vbMaximizedFocus
End Sub

Answer 2

你正在寻找的是这样的：

Sub test()
  Dim filePath As String
  filePath = "C:\ExcelTest\"

  Dim xRow As Variant
  For Each xRow In Range("A1:D100").Rows
    If xRow(1, 4).Value = "TRUE" Then

      Open filePath & xRow(1, 1) & ".txt" For Output As #1
      Write #1, xRow(1, 2), xRow(1, 3)
      Close #1

    End If
  Next
End Sub

虽然它可以正常工作，但我不会像现在这样使用它。
如果您有任何问题，请尽管提问。

编辑

我已经运行了一些测试并注意到 Windows 阻止我在特定文件夹中创建文件...请尝试将其作为新的子目录并运行它：

Sub testForText()
  Open Environ("AppData") & "\Testing.txt" For Output As #1
  Write #1, "dada"
  Close #1
  Shell "notepad.exe " & Environ("AppData") & "\Testing.txt", vbNormalFocus
End Sub

然后告诉我记事本是否以“Testing.txt”打开