Excel列表,VBA从单元格中添加

我正在build立一个CSV文件的产品导入到网上商店。 由于产品具有不同的属性(尺寸和/或颜色),我需要将这些添加为文件中的变体。 总共我有大约800行,需要填补下面的图片所示的空白空间。 变化的范围在三到五之间变化。

Screendump,Excel

我一直在努力获得某种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内容…

我非常感谢任何帮助!

macros中缺less的主要是数据的循环,空单元的循环。

如果您打算多次使用此选项,则可能还需要更仔细地select正确的列,因为它当前从所选单元格开始。

也许是这样的:

 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 

你的方法的一个显而易见的问题是,工作表单元格中可以存储多less个字符(最多32,767个?)是有限制的。 当然,这对你来说可能已经足够了,但是如果不是的话…

另一个想法是,你正试图设置它,像logging一个“手工”的macros,而不是真正的自动化过程。

无论如何,这(无论需要修改)应该有效地做到这一点。 sCSVstring可以保存为文本/ 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