VBA

Question

我有一个宏，它在从 D 列开始的一系列列中创建数据，n=iCount，例如如果 iCount=4，则列为 D、E、F、G。在所有这些列中，如果单元格不包含“[AT]”，我现在想清除单元格内容。

最理想的是，我还希望将所有剩余数据移到左侧，这意味着每行的数据都从 D 列开始并且没有间隙，但这是次要的。

我已经包含了我的宏的前面部分，以防有帮助（如果不干净，抱歉）。

谢谢大家！

Dim Treffer As Worksheet
Dim iCount As Long
Dim i As Long
Set Treffer = ActiveWorkbook.Worksheets("Treffer")

iCount = InputBox(Prompt:="How many columns should be created?")

For i = 1 To iCount
    Treffer.Columns(5).EntireColumn.Insert
    Treffer.Range("E1").Value = "Anmelder" & (iCount + 1) - i
Next i
    
    Treffer.Range("D2:D" & Treffer.Cells(Rows.Count, "D").End(xlUp).Row).TextToColumns , _
        Destination:=Treffer.Range("E2:E" & Treffer.Cells(Rows.Count, "N").End(xlUp).Row), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :="" & Chr(10) & "", FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True

    Treffer.Columns(4).EntireColumn.Delete

Answer 1

似乎您正在创造更多继续使用 TextToColumns 的作品，最好使用 Split()。
尝试这样的事情：

Sub Tester()

    Dim Treffer As Worksheet
    Dim iCount As Long, i As Long, arr, c As Range, os As Long, v
    
    Set Treffer = ActiveWorkbook.Worksheets("Treffer")
    
    iCount = InputBox(Prompt:="How many columns should be created?")
    For i = 1 To iCount
        Treffer.Columns(5).EntireColumn.Insert
        Treffer.Range("E1").Value = "Anmelder" & (iCount + 1) - i
    Next i
    
    For Each c In Treffer.Range("D2:D" & Treffer.Cells(Rows.Count, "D").End(xlUp).Row).Cells
        If Len(c.Value) > 0 Then                   'cell has a value?
            arr = Split(c.Value, vbLf)             'split value on Chr(10)
            os = 1                                 'reset column offset
            For Each v In arr                      'loop over array values
                If InStr(1, v, "[AT]") > 0 Then    'value contains "[AT]" ?
                    c.Offset(0, os).Value = v      'populate in offset column
                    os = os + 1                    'next column to right
                    If os > iCount Then Exit For   'stop if reached column count limit
                End If 'value has [AT]
            Next v
        End If         'any cell value
    Next c
    
    Treffer.Columns(4).EntireColumn.Delete

End Sub

VBA - 如果不包含值，如何清除多列单元格内容

VBA - How to Clear Cell Contents across Multiple Columns if Value not Contained

excel

if-statement

range

multiple-columns