Prompt for value, then copy but add text

问题

I've written a macro that prompts the user for a name and then a number. This is used to populate the first 3 cells in column G after the header row. What I really need the macro to do is then repeat this for the next 3 rows, but add 10 the number the user entered.

Sub Set_Tag()

Dim Tag, TagName As String
Dim x, TagNum As Integer

TagName = InputBox("What is the product tag name? Ex. Apple", "Tag Name")
TagNum = InputBox("What is the first product tag #? Ex. 500", "Tag #")

Tag = TagName & "_" & TagNum
x = Application.WorksheetFunction.CountIf(Range("J:J"), " ")

ActiveSheet.Range("G2").Value = TagName & "_" & TagNum
ActiveSheet.Range("G3").Value = TagName & "_" & TagNum & "_T"
ActiveSheet.Range("G4").Value = TagName & "_" & TagNum & "_NE"


End Sub

So if the user enters the example Apple and 500 in the two prompts, cells G2-G4 then become:

Apple_100
Apple_100_T
Apple_100_NE

Next step is to have this repeated until it reaches row x (which is always a multiple of 3). So if x counts 9 rows, the values in cells G2-10 should be:

Apple_100
Apple_100_T
Apple_100_NE
Apple_110
Apple_110_T
Apple_110_NE
Apple_120
Apple_120_T
Apple_120_NE

How can I improve my macro to achieve this? Thanks!

回答1:

Replace the bottom three lines with these:

With ActiveSheet.Range("G2")
    For i = 1 To x Step 3
        .Item(i + 0) = TagName & "_" & TagNum + k
        .Item(i + 1) = TagName & "_" & TagNum + k & "_T"
        .Item(i + 2) = TagName & "_" & TagNum + k & "_NE"
        k = k + 10
    Next
End With

And..

Add this line at the top:

Dim i As Long, k As Long

That's it.

Note: as an aside you should correct your Dim statements. For example, Dim Tag, TagName As String instructs VBA that Tag is a Variant type not a String. The same holds for x. Your code makes x a Variant, not an Integer. Finally, there is no compelling reason to use Integers here. Instead you should use Longs. VBA is optimized for Longs.

来源：https://stackoverflow.com/questions/33614705/prompt-for-value-then-copy-but-add-text

标签

excel

vba

excel-vba

excel-2010