连接代码不按预期工作

I wrote a code in Excel VBA for concatenating values upto 7 columns in a row with ^ between them. I noticed that if I enter the same value in the first six columns, I get the output without the ^. This doesn't happen if i fill upto column 7 or 5. The code is as below:

我在Excel VBA中编写了一个代码,用于连接最多7列的值和它们之间的^。我注意到如果我在前六列中输入相同的值,我得到没有^的输出。如果我填写第7列或第5列,则不会发生这种情况。代码如下:

Private Sub CommandButton21_Click() 
    Cells(2, 1).Select  
    Dim stri As String, eaid_1 As String, eaid_2 As String, eaid_3 As String, _
        eaid_4 As String, eaid_5 As String, eaid_6 As String, eaid_7 As String
    Do Until Selection.Value = ""     
        eaid_1 = Selection.Value     
        eaid_2 = Selection.Offset(0, 1).Value     
        eaid_3 = Selection.Offset(0, 2).Value     
        eaid_4 = Selection.Offset(0, 3).Value     
        eaid_5 = Selection.Offset(0, 4).Value     
        eaid_6 = Selection.Offset(0, 5).Value     
        eaid_7 = Selection.Offset(0, 6).Value          
        stri = eaid_1 & "^" & eaid_2 & "^" & eaid_3 & "^" & eaid_4 & "^" & eaid_5 _
                      & "^" & eaid_6 & "^" & eaid_7          
        Selection.Offset(0, 8).Value = stri     
        Selection.Offset(1, 0).Select  
    Loop  

    Cells(2, 9).Select  
    Dim x As String, y As String, z As String  
    Do Until Selection.Value = ""  
        x = Selection.Value 
        y = Right(x, 6) 
        z = Replace(y, "^", "")  
        x = Replace(x, y, z)          
        Selection.Offset(0, 0).Value = x 
        Selection.Offset(1, 0).Select  
    Loop  
End Sub

2 个解决方案

#1

Private Sub CommandButton21_Click()
    Const NUM_COLS As Long = 7
    Dim c As Range, rng As Range

    Set c = Cells(2, 1)
    Do While c.Value <> ""
        Set rng = c.Resize(1, Application.CountA(c.Resize(1, NUM_COLS)))
        c.Offset(0, NUM_COLS).Value = _
               Join(Application.Transpose(Application.Transpose(rng.Value)), "^")
        Set c = c.Offset(1, 0)
    Loop
End Sub

Some explanation:

• You should avoid using Select/Activate to work with ranges, and instead use a Range variable (such as c above)

您应该避免使用Select / Activate来处理范围,而是使用Range变量(例如上面的c)

• The DoWhile...Loop starts at A2 and continues until c is blank

DoWhile ...循环从A2开始并一直持续到c为空

• The rng variable represents a Range object beginning at c and extending to the right for as many cells as there are values (to a maximum of 7 cells). The CountA worksheet function is used to count the number of values, and Resize creates a range of the required size.

rng变量表示一个Range对象,从c开始并向右延伸,以获得与值一样多的单元格(最多7个单元格)。 CountA工作表函数用于计算值的数量,Resize创建所需大小的范围。

• The repeated Application.Transpose creates a single-dimension array out of the 2-D array resulting for rng.Value. Don't ask me to explain exactly why that works ;-)

重复的Application.Transpose从2-D数组中创建一个单维数组,得到rng.Value。不要让我解释为什么有效;-)

• Finally, Join takes the 1-D array and returns a single string with each element of the input array concatenated to the next and separated by the second argument ("^")

最后,Join获取1-D数组并返回单个字符串,输入数组的每个元素连接到下一个并由第二个参数(“^”)分隔

#2

The code below will "CONCATENATE" each row (where Column A has data) and checks each row where the last Column has data, then it combines them together (adding "^" between each array elements). Currently it puts the result string in Column I, like in your post).

下面的代码将“CONCATENATE”每一行(其中列A有数据)并检查最后一列具有数据的每一行,然后将它们组合在一起(在每个数组元素之间添加“^”)。目前,它将结果字符串放在第一列中,就像在帖子中一样)。

What is the purpose your second loop ? what your final result should look like ?

你的第二个循环的目的是什么?你的最终结果应该是什么样的?

Private Sub CommandButton21_Click()

Dim Rng             As Range
Dim stri            As String
Dim eaid()          As Variant
Dim lRow            As Long
Dim i               As Long
Dim LastColumn      As Long

' start from Cell A2
lRow = 2
Do Until Range("A" & lRow).Value = ""
    ' get the last column with data in current row
    LastColumn = Cells(lRow, Columns.Count).End(xlToLeft).Column
    ReDim eaid(1 To LastColumn)

    Set Rng = Range("A" & lRow)

    ' read all Range values to one-dimension array using Transpose
    eaid = Application.Transpose(Application.Transpose(Rng.Resize(1, LastColumn).Value))

    ' read all array elements to String
    For i = LBound(eaid) To UBound(eaid)
        If i = LBound(eaid) Then
            stri = stri & eaid(i)
        Else
            stri = stri & "^" & eaid(i)
        End If
    Next i

    Rng.Offset(0, 8).Value = stri
    stri = ""
    lRow = lRow + 1
Loop

End Sub