时间戳

首页 > 解决方案 > 使用 msgbox 循环遍历范围

arrays - 使用 msgbox 循环遍历范围

问题描述

循环穿过一个范围时，我撞到了一点墙。我所做的是创建一个表，当在表中选择一个数量时，该表中的一个范围被传输到下一个空白行上的另一个数组。为了加快这个过程，我想做的是，如果我想再次将相同的信息添加到 msgbox 下的下一行，询问是或否，然后循环。

下面是我的代码，我已经尝试了几个变体但没有成功

Sub Add()

Dim foundCell As Range
Dim mysearch As Integer
Dim iRow As Long, Last As Long
Dim ws1 As Worksheet, ws2 As Worksheet

Set ws2 = Worksheets("Output")

iRow = ws2.Cells(ws2.Rows.Count, "V").End(xlUp).Row + 1
Last = ws2.Cells(ws2.Rows.Count, "N").End(xlUp).Row

    mysearch = ws2.Range("N10").Value


If ws2.Range("N10").Value = 0 Then
    MsgBox "No Product Selected"
    Exit Sub
    Else
    Do
    Set foundCell = ws2.Range("N12:N" & Last).Find(What:=mysearch, Lookat:=xlWhole)
        If Not foundCell Is Nothing Then
            ws2.Cells(iRow, 22).Value = foundCell.Offset(0, -3).Value
            ws2.Cells(iRow, 23).Value = foundCell.Offset(0, -4).Value
            ws2.Cells(iRow, 24).Value = foundCell.Offset(0, -2).Value
            ws2.Cells(iRow, 25).Value = foundCell.Offset(0, -1).Value
            ws2.Cells(iRow, 26).Value = foundCell.Offset(0, 1).Value
            ws2.Cells(iRow, 27).Value = foundCell.Value
            ws2.Cells(iRow, 28).Value = foundCell.Offset(0, 2).Value
        answer = MsgBox("Would you like to add this product to the next line?", vbYesNo + vbQuestion, "MORE PRODUCTS?")
            If answer = vbYes Then
                Loop
                Else
                'Exit Sub
            End If
        End If
End If

Sheets("Output").Range("N12:N35").ClearContents

End Sub

标签： arraysvbaexcel

解决方案

我不确定我是否正确，但这就是我所理解的

Option Explicit

Sub Add()

    Dim foundCell As Range
    Dim mysearch As Integer
    Dim iRow As Long, Last As Long
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim answer As Boolean

    Set ws2 = Worksheets("Output")

    iRow = ws2.Cells(ws2.Rows.Count, "V").End(xlUp).Row + 1
    Last = ws2.Cells(ws2.Rows.Count, "N").End(xlUp).Row

        mysearch = ws2.Range("N10").Value

    If ws2.Range("N10").Value = 0 Then
        MsgBox "No Product Selected"
        Exit Sub
    Else
        Set foundCell = ws2.Range("N12:N" & Last).Find(What:=mysearch, Lookat:=xlWhole)
        If Not foundCell Is Nothing Then
            Do 'this way it'll copy at least once
                answer = CopyCells(foundCell, ws2, iRow)
            Loop While answer 'copy till user choose NO
        End If
    End If

    Sheets("Output").Range("N12:N35").ClearContents
End Sub

Function CopyCells(SrcRange As Range, DestWs As Worksheet, iRow As Long) As Boolean

    Dim UserChoice As Long

    DestWs.Cells(iRow, 22).Value = SrcRange.Offset(0, -3).Value
    DestWs.Cells(iRow, 23).Value = SrcRange.Offset(0, -4).Value
    DestWs.Cells(iRow, 24).Value = SrcRange.Offset(0, -2).Value
    DestWs.Cells(iRow, 25).Value = SrcRange.Offset(0, -1).Value
    DestWs.Cells(iRow, 26).Value = SrcRange.Offset(0, 1).Value
    DestWs.Cells(iRow, 27).Value = SrcRange.Value
    DestWs.Cells(iRow, 28).Value = SrcRange.Offset(0, 2).Value

    UserChoice = MsgBox("Would you like to add this product to the next line?", vbYesNo + vbQuestion, "MORE PRODUCTS?")

    If UserChoice = 6 Then
        CopyCells = True
        iRow = iRow + 1
    Else
        CopyCells = False
    End If

End Function

可能需要一些调整。也许您可以发布您的输入和所需的输出？

推荐阅读