Excel列表，VBA从单元格添加

Question

我正在构建要导入网上商店的CSV文件。由于产品具有不同的属性（大小和/或颜色），我需要将它们添加为文件中的变体。总共我有大约800行，需要填充空白区域，如下图所示。变化范围在三到五之间变化。

我一直在努力寻找某种VBA代码。

Sub FillVariations()
'
' Makro8 Makro
'

' Find row with content and copy

    Selection.End(xlDown).Select
    Selection.Copy

' Move one step down

    ActiveCell.Offset(1, 0).Activate

' Add =" <ctrl-v> " & " - " & az<samerow>

    ActiveCell.FormulaR1C1 = _
        "=""Axelväska/handväska, Crazy Horse, RCH7"" & "" - "" & RC[47]"

' Move one step down

    ActiveCell.Offset(1, 0).Activate

End Sub

Ctrl-V是思想，但（显然）不起作用。

基本上：向下移动一排。如果单元格有内容 - 复制它。向下移动一排。粘贴内容，添加空格，连字符和另一个空格，然后粘贴同一行上的AZ列中的内容。向下移动一排。如果单元格为空，则粘贴先前复制的内容，添加空格，连字符和空格并粘贴新行中的AZ内容...

我非常感谢任何帮助！

Answer 1

宏中缺少的主要内容是数据循环和空单元格循环。

如果您计划多次使用此功能，您可能还需要更仔细地选择正确的列，因为它当前从所选的任何单元格开始。

也许是这样的：

Sub FillVariations()
' 
' Makro8 Makro
'
'figure out how far down data goes
Range("AZ2").Select
Selection.End(xlDown).Select
Dim endrow
endrow = Selection.Row

'always start in the correct column
Range("E1").Select
Selection.End(xlDown).Select


Dim basename

'loop through all data
Do While ActiveCell.Row < endrow
    'Store cell of current base name
    basename = Selection.Address

    'loop through empty cells and set formula if cell isn't empty
    Do While True
        ActiveCell.Offset(1, 0).Activate

        'if next cell isn't empty, isn't past the end of the list, go to outer loop
        If ActiveCell.Formula = "" And ActiveCell.Row <= endrow Then
            ActiveCell.Formula = "=CONCATENATE(" & basename & ","" - ""," & "AZ" & Selection.Row & ")"
        Else
            Exit Do
        End If
    Loop
Loop

End Sub

Answer 2

您的方法的一个明显问题是工作表单元格中可以存储多少个字符（最多32,767？）;当然，这对你来说已经足够了，但如果没有......

另一种想法是，你正试图设置它，就像记录一个宏来做它＆＃34;手工＆＃34;并没有真正实现流程自动化。

无论如何，这（无论需要什么修改）都应该有效地进行。 sCSV字符串可以保存为text / csv文件。

Private Sub Build_String_CSV()
    Dim iRowStart As Long
    Dim iRowEnd As Long
    Dim i As Long
    Dim sCSV As String

    iRowStart = 1 ' or whatever
    iRowEnd = 800 ' or whatever
    ' Note that the values above can be found dynamically, of course
    For i = iRowStart To iRowEnd
            sCSV = sCSV & " - " & ActiveSheet.Range("AZ" & i)
    Next
    sCSV = sCSV = Mid(sC,SV, 4, 10000000) ' remove the very first 3 characters: space-dash-space
    ' Save the sCSV string as csv file
End Sub