VBA实现读取text文本内容，写入到单元格

Posted 2023-04-12

VBA实现读取text文本内容，写入到单元格如图：
求实现vba代码
读取text文本内容过滤掉每行的@@@@@@@@@@
，将多行内容顺序写入到excel H列的单元格里，写之前判断该列的单元格是否有内容，若有，则在其下一单元格开始写入。

Sub test()
    Dim starRng As Range
    Set starRng = Sheet1.Range("B5") '要输入的第一个单元格
    
    Dim txtPath As String, nextLine As String
    txtPath = ThisWorkbook.Path & "\\temp.txt" 'txt所在的目录
    
    Open txtPath For Input As #1
    
    Do While Not EOF(1)
        On Error Resume Next
        Line Input #1, nextLine
        If InStr(nextLine, "@@@@") > 0 Then '如果包含连续4个以上的@ 则换行
            Set starRng = starRng.Offset(1, 0)'下一行
        Else
            starRng = starRng & IIf(starRng.Value = "", "", Chr(10) & Chr(13)) & nextLine
        End If
    Loop
    Close #1
End Sub

 

 

我就要悬赏，能给多少就给多少，

追问

在你的代码基础上改编了一下 调试有一处不通过啊 怎么解决？

好了 已解决 多谢 你的代码比我的简化多了 简单的逻辑实现了想要的功能

这是代码

参考技术A 悬赏太少了追问

先解决了再说 悬赏不是问题

追答

好的，这可是你说的，相信你一次，代码等会给你发上来，正在编辑

把你的文本文档发到[e-mail]

追问

文本文档里的内容不固定 就以每行的@@@@@@当作界定单元格

已解决了

根据条件 VBA 写入下 3 个单元格，同时保持公式不变

【中文标题】根据条件 VBA 写入下 3 个单元格，同时保持公式不变

【英文标题】：Write to next 3 cells based on condition VBA while leaving formulas intact

【发布时间】：2015-05-17 16:53:44

【问题描述】：

因此，我正在尝试编写一个 vba 宏，如果前一个单元格中包含单词“lunch”，则可以将单词“lunch”写入接下来的 3 个单元格中，午餐通过 if 语句填充到单元格中。我想要一些 vba 代码来读取行中的每个单元格，如果它找到了单词 lunch。接下来的 3 个单元格现在将包含单词 lunch。我想保留单元格中的公式，以便电子表格的功能保持不变。这是我到目前为止所写的。但它没有按预期工作。请帮忙

Public Sub WriteLunchToCell()
Dim rg As Range
For Each rg In Sheet1.Range("BY62:FP62")
    If InStr(1, rg.Value, "Lunch", vbTextCompare) Then
        rg.Offset(, 1) = "Lunch"
        rg.Offset(, 2) = "Lunch"
        rg.Offset(, 3) = "Lunch"


End If
Next

结束子

【参考方案1】：

如果您希望保留公式，则需要更改单元格的格式而不是值。

rg.Offset(, 1).NumberFormat = "General ""LUNCH"""

【参考方案2】：

试试这样的：

Set Rng = Range("a1:a6")

For Each cel In Rng
    If InStr(UCase(cel.Value), "LUNCH") <> 0 Then
        cel.Offset(0, 1).Value = "Lunch"
        cel.Offset(0, 2).Value = "Lunch"
        cel.Offset(0, 3).Value = "Lunch"
    End If
Next cel

【讨论】：

谢谢。到目前为止，我有这个代码工作，但现在我需要它在下一行运行。直到第 300 行左右Public Sub WriteLunchToCell() Dim rg As Range Dim row As Range Dim cell As Range For Each rg In Sheet1.Range("BG62:EX300") If InStr(1, rg.Value, "3", vbTextCompare) Then rg.Offset(, 1) = "3" rg.Offset(, 2) = "3" rg.Offset(, 3) = "3" Exit For End If Next End Sub

【参考方案3】：

你可以嵌套另一个循环：

For i = 1 To 300
    Set MyRange = Sheet1.Range("BY" & 61 + i & ":FP" & 61 + i)

    For Each rg In MyRange

        If InStr(1, rg.Value, "Lunch", vbTextCompare) Then
            rg.Offset(, 1) = "Lunch"
            rg.Offset(, 2) = "Lunch"
            rg.Offset(, 3) = "Lunch"


    End If
    Next rg

Next i