☰

更改循环以将结果写入其他单元格

tag-icon • tag-icon worksheet-function vba microsoft-excel-2007
更改循环以将结果写入其他单元格

我已经使用以下代码一段时间了，但需要一些帮助才能进行一项更改。我试了又试，但就是不行。如果有人能帮我看一下，我的研究表明我正在寻找一个“更改循环以将结果写入其他单元格”。请参阅下面的 Excel 图片。

现在，代码会找到在 A1 单元格中输入的所有匹配数字，并将它们发布到相应的单元格 L1:l12 中。我需要代码仅在以下单元格之一中发布相同的信息：C17、C18、F17、F18。此外，如果代码可以将匹配数字下方单元格中的数字（来自单元格 A1，请参阅下面的示例结果）复制并粘贴到上述更改循环左侧的单元格中，请粘贴到以下单元格中：B17、B18、E17、E18。

根据示例 Excel 图像的预期结果示例。在单元格 A1 中输入数字 8，在单元格 A34 中发现 8。因此，8-15 将被复制并粘贴到 L8 和 C17。它还会将数字 7 从单元格 A35（以下数字）复制到单元格 B17。代码也会对单元格 F20 和 E21 执行相同操作。复制和粘贴完成后，所有单元格 B34、C34 和 D34 都需要删除，因此将为空白。F20、G20 和 H20 也是如此。我希望这很清楚，如果不清楚，请提出建议，我会澄清。

我的工作代码如下，我的尝试也在该代码之下。

Excel 工作表

工作代码：

Sub do_it()

    Dim n, sht As Worksheet, cell As Range, num, tmp, rngDest As Range

    Set sht = ActiveSheet

    n = sht.Range("A1")

    For Each cell In sht.Range("A20:A34,D20:D34,G20:G34").Cells

        tmp = cell.Offset(0, 1).Value

        If cell.Value = n And tmp Like "*#-#*" Then

            'get the first number
            num = CLng(Trim(Split(tmp, "-")(0)))
            Debug.Print "Found a positive result in " & cell.Address
 'find the next empty cell in the appropriate row
         Set rngDest = sht.Cells(num, sht.Columns.Count).End(xlToLeft).Offset(0, 1)
            'make sure not to add before col L
            If rngDest.Column < 12 Then Set rngDest = sht.Cells(num, 12)

            cell.Offset(0, 1).Copy rngDest

        End If
    Next

End Sub

我的尝试：

Sub do_it()

    Dim n, sht As Worksheet, cell As Range, num, tmp, rngDest As Range

    Set sht = ActiveSheet

    n = sht.Range("A1")

    For Each cell In sht.Range("A20:A34,D20:D34,G20:G34").Cells

        tmp = cell.Offset(0, 1).Value

        If cell.Value = n And tmp Like "*#-#*" Then

            'get the first number
            num = CLng(Trim(Split(tmp, "-")(0)))
            Debug.Print "Found a positive result in " & cell.Address
 'find the next empty cell in the appropriate row
         Set rngDest = (“ C17, C18, F17, F18’)
             cell.Offset(0, 1).Copy rngDest

        End If
    Next

End Sub

答案1

它可能不漂亮或不可扩展，但由于我不确定您从长远来看到底想要实现什么，所以这里有一些应该可行的方法。

首先，该行For Each cell In sht.Range("A20:A34,D20:D34,G20:G34").Cells与示例中使用的单元格不对应，因此我将其更改为：

For Each cell In sht.Range("A20:A34,E20:E34,I20:I34").Cells

然后我最后劫持了 tmp 变量，因为它不再使用，并将它设置为查找找到匹配项的列的最后一个单元格，如下所示：

Set tmp = sht.Cells(Cells(Rows.Count, cell.Column).End(xlUp).Row, cell.Column)

然后我们需要指定新的框，并确保每个框只填充一次。您可以通过检查第一个框是否为空或使用计数器来做到这一点。无论哪种方式，只要您找到少于 4 个匹配项，它就会正常工作。

最终结果是这样的，根据需要进行修改；

Sub do_it()

Dim sht As Worksheet, n As String, cell, num, tmp, rngDest As Range, i As Integer
Set sht = ActiveSheet
n = sht.Range("A1").Value
i = 0
For Each cell In sht.Range("A20:A34,E20:E34,I20:I34").Cells
    tmp = cell.Offset(0, 1).Value
    If cell.Value = n And tmp Like "*#-#*" Then
       'get the first number
        num = CLng(Trim(Split(tmp, "-")(0)))
        'find the next empty cell in the appropriate row
        Set rngDest = sht.Cells(num, sht.Columns.Count).End(xlToLeft).Offset(0, 1)
        'make sure not to add before col L
        If rngDest.Column < 12 Then Set rngDest = sht.Cells(num, 12)
        cell.Offset(0, 1).Copy rngDest

' This is getting the next number in A/E/I----
        Set tmp = cell.Offset(1, 0)

' This is filling up B17 - F18 in order until filled
        If sht.Range("B17").Value = "" Then
            sht.Range("C17").Value = cell.Offset(0, 1).Value
            sht.Range("B17").Value = tmp.Value
        ElseIf sht.Range("B18").Value = "" Then
            sht.Range("C18").Value = cell.Offset(0, 1).Value
            sht.Range("B18").Value = tmp.Value
        ElseIf sht.Range("E17").Value = "" Then
            sht.Range("F17").Value = cell.Offset(0, 1).Value
            sht.Range("E17").Value = tmp.Value
        ElseIf sht.Range("E18").Value = "" Then
            sht.Range("F18").Value = cell.Offset(0, 1).Value
            sht.Range("E18").Value = tmp.Value
        End If
  '---- This clears the BCD/FGH/JKL columns after using the value ----
        'cell.Offset(0, 1).Resize(, 3).Value = ""


   End If
Next cell
End Sub

相关内容