級聯非空值vba

Question

我需要連接2列中的行，僅用於唯一標識。 Jeeped幫我下面的代碼

Option Explicit 
Sub qwewreq() 
    Dim rw As Long 
    With Worksheets("Sheet3") 
     For rw = .Cells(.Rows.Count, "A").End(xlUp).Row - 1 To 2 Step -1 
      If .Cells(rw, "A").Value2 = .Cells(rw + 1, "A").Value2 Then 
       .Cells(rw, "B") = .Cells(rw, "B").Value2 &Chr(10) & .Cells(rw + 1, "B").Value2 
       .Cells(rw, "C") = .Cells(rw, "C").Value2 &Chr(10) & .Cells(rw + 1, "C").Value2 
       .Rows(rw + 1).EntireRow.Delete 
      End If 
     Next rw 
    End With 
End Sub 

我想盡一切非空值後添加一個符號。以上代碼在每個單元格後添加符號。是否可能以某種方式修改此代碼，以便Chr（10）只能在非空之後添加？

謝謝！這有幫助！

Answer 1

如果B列爲空白，則不包括換行符。 你可以通過幾種方法來做到這一點。 一種方法是嵌入式iif。

Option Explicit 
Sub qwewreq() 
    Dim rw As Long 
    With Worksheets("Sheet3") 
     For rw = .Cells(.Rows.Count, "A").End(xlUp).Row - 1 To 2 Step -1 
      If .Cells(rw, "A").Value2 = .Cells(rw + 1, "A").Value2 Then 
       .Cells(rw, "B") = .Cells(rw, "B").Value2 & iif(len(.Cells(rw, "B").Value2)>0,Chr(10),"") & .Cells(rw + 1, "B").Value2 
       .Cells(rw, "C") = .Cells(rw, "C").Value2 & iif(len(.Cells(rw, "C").Value2)>0,Chr(10),"") & .Cells(rw + 1, "C").Value2 
       .Rows(rw + 1).EntireRow.Delete 
      End If 
     Next rw 
    End With 
End Sub 

的另一種方式，更長一點，但更易於閱讀：

Option Explicit 
Sub qwewreq() 
    Dim rw As Long 
    With Worksheets("Sheet3") 
     For rw = .Cells(.Rows.Count, "A").End(xlUp).Row - 1 To 2 Step -1 
      If .Cells(rw, "A").Value2 = .Cells(rw + 1, "A").Value2 Then 
       if len(.Cells(rw, "B").Value2) > 0 then 
        .Cells(rw, "B") = .Cells(rw, "B").Value2 &Chr(10) & .Cells(rw + 1, "B").Value2 
       else 
        .Cells(rw, "B") = .Cells(rw + 1, "B").Value2 
       end if 
       if len(.Cells(rw, "C").Value2) > 0 then 
        .Cells(rw, "C") = .Cells(rw, "C").Value2 &Chr(10) & .Cells(rw + 1, "C").Value2 
       else  
        .Cells(rw, "C") = .Cells(rw + 1, "C").Value2 
       end if 
       .Rows(rw + 1).EntireRow.Delete 
      End If 
     Next rw 
    End With 
End Sub 

Answer 2

你的問題不是很清楚。希望我的理解足以回答：

Option Explicit 
Sub qwewreq() 
Dim rw As Long 
With Worksheets("Sheet1") 
    For rw = .Cells(.Rows.Count, "A").End(xlUp).Row - 1 To 2 Step -1 
     If .Cells(rw, "A").Value2 = .Cells(rw + 1, "A").Value2 Then 
      If .Cells(rw + 1, "B").Value2 <> "" Then 
      .Cells(rw, "B") = .Cells(rw, "B").Value2 & Chr(10) & .Cells(rw + 1, "B").Value2 
      Else 
      .Cells(rw, "B") = .Cells(rw, "B").Value2 
      End If 
      If .Cells(rw + 1, "C").Value2 <> "" Then 
      .Cells(rw, "C") = .Cells(rw, "C").Value2 & Chr(10) & .Cells(rw + 1, "C").Value2 
      Else 
      .Cells(rw, "C") = .Cells(rw, "C").Value2 & Chr(10) 
      End If 
      .Rows(rw + 1).EntireRow.Delete 
     End If 
    Next rw 
End With 
End Sub