Excel列表VBA连接

Excel列表VBA连接

问题描述:

下图显示了我拥有的Excel列表。列A-C是我拥有的内容。列D和E是我正在寻找的结果。我已经手动输入它来显示结果。Excel列表VBA连接

Excel list

目前我的代码看起来是这样的:

Option Explicit 

Sub New_SKU() 

Dim wb As Workbook 
Dim ws As Worksheet 

'figure out how far down data goes 
Dim endrow As Long 
Dim currentrow As Long 
Dim basename 

Set wb = ThisWorkbook 
Set ws = wb.Sheets("Blad1") 

With ws 
    endrow = .Cells(.Rows.Count, "A").End(xlUp).Row 

    'always start in the correct column 
    .Cells(.Cells(1, "B").End(xlDown).Row, "B").Activate 

    'loop through all data 
    Do While ActiveCell.Row < endrow 

     'loop through empty cells and set formula if cell isn't empty 
     Do While ActiveCell.Row <= endrow 

      'if next cell isn't empty, isn't past the end of the list, go to outer loop 
      If ActiveCell.Formula <> "" And ActiveCell.Offset(1, 0).Formula = "" And ActiveCell.Row <= endrow Then 

       basename = Selection.Address 

       ActiveCell.Offset(0, 2).Formula = "=CONCATENATE(" & basename & ",""-""," & "C" & Selection.Row & ")" 
'    ActiveCell.Offset(0, 3).Formula = "=" & basename & "" 
       ActiveCell.Offset(1, 0).Activate 

'   If ActiveCell.Formula = "" And ActiveCell.Offset(0, 1).Formula <> "" And ActiveCell.Row <= endrow Then 
'    ActiveCell.Offset(0, 2).Formula = "=CONCATENATE(" & basename & ",""-""," & "C" & Selection.Row & ")" 
'    ActiveCell.Offset(0, 3).Formula = "=" & basename & "" 
'    ActiveCell.Offset(1, 0).Activate 

'   If ActiveCell.Formula = "" And ActiveCell.Offset(0, 1).Formula <> "" And ActiveCell.Row <= endrow Then 
'    ActiveCell.Offset(0, 2).Formula = "=CONCATENATE(" & basename & ",""-""," & "C" & Selection.Row & ")" 
'    ActiveCell.Offset(0, 3).Formula = "=" & basename & "" 
'    ActiveCell.Offset(1, 0).Activate 

'   If ActiveCell.Formula = "" And ActiveCell.Offset(0, 1).Formula <> "" And ActiveCell.Row <= endrow Then 
'    ActiveCell.Offset(0, 2).Formula = "=CONCATENATE(" & basename & ",""-""," & "C" & Selection.Row & ")" 
'    ActiveCell.Offset(0, 3).Formula = "=" & basename & "" 
'    ActiveCell.Offset(1, 0).Activate 

'   If ActiveCell.Formula = "" And ActiveCell.Offset(0, 1).Formula <> "" And ActiveCell.Row <= endrow Then 
'    ActiveCell.Offset(0, 2).Formula = "=CONCATENATE(" & basename & ",""-""," & "C" & Selection.Row & ")" 
'    ActiveCell.Offset(0, 3).Formula = "=" & basename & "" 
'    ActiveCell.Offset(1, 0).Activate 

'   If ActiveCell.Formula = "" And ActiveCell.Offset(0, 1).Formula <> "" And ActiveCell.Row <= endrow Then 
'    ActiveCell.Offset(0, 2).Formula = "=CONCATENATE(" & basename & ",""-""," & "C" & Selection.Row & ")" 
'    ActiveCell.Offset(0, 3).Formula = "=" & basename & "" 
'    ActiveCell.Offset(1, 0).Activate 

      Else 
       Exit Do 
      End If 
'   End If 
'   End If 
'   End If 
'   End If 
'   End If 
     Loop 
    Loop 

End With 

End Sub 

我从我得到的帮助与先前类似的问题重用代码。

我的第一个问题:

如果取消对if语句,当我启动脚本的Excel一片空白(白)和摊位立刻。

以当前状态运行脚本(If-satements已注释掉),我可以看到我在单元格D2中获得了正确的结果,然后选中了单元格B3(请注意,列D中没有结果或E),然后屏幕变空白并且Excel停止。我在E栏中没有得到任何结果。

由于尺寸(C列)有变化,它可以在2-3到5-6之间变化。

我不明白为什么我不会在E栏中收到结果,为什么它会停顿并变白。

任何想法?

+1

有点难以遵循,但我认为更容易填补空白,然后使用拼接公式一路下来。你甚至不需要VBA。 – SJR

+0

只是为了阐述,代码有点难以遵循的一个原因,可能棘手的是你使用Select和Activate。尽可能避免,而这通常是。 – SJR

按照上述评论,这里是一个不同的方法

Sub x() 

Dim r As Long 

Columns(2).SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=r[-1]c" 

For r = 2 To Range("A" & Rows.Count).End(xlUp).Row 
    Cells(r, 4).Value = Cells(r, 2).Value & "-" & Cells(r, 3).Value 
    Cells(r, 5).Value = Cells(r, 2).Value 
Next r 

Columns(2).SpecialCells(xlCellTypeFormulas).ClearContents 

End Sub 

如果没有问题与非VBA的答案,你可以粘贴此公式D2抄下:

=IF(B2="",LEFT(D1,FIND("-",D1)-1)&"-"&C2,B2&"-"&C2)