[發問] 請教VBA 兩行儲存格的字串合併問題~~~~~~~~~~

ji12345678

問問題101.11.20.rar (9.78 KB)

下載次數: 25

2012-11-20 22:22

:(
Sub TEST()
    ' Worksheets("Sheet1").Range("A1:A65530") = Worksheets("Sheet1").Range("B1:B65530") & Worksheets("Sheet1").Range("C1:C65530") '型態不符合
   
    all_number = ThisWorkbook.Sheets("Sheet1").Range("B65536").End(xlUp).Row
    For I = 2 To all_number
      Cells(I, 1) = Trim(Cells(I, 2)) & Trim(Cells(I, 3))
    Next I
End Sub

有沒有辨法不跑迴圈，一個個組合字串，
可有方法類似Range  大範圍的組合字串，謝謝~~~指教

stillfish00

回復 1# ji12345678
不用迴圈..

1. Sub TEST()
   
2.     With Sheets("Sheet1").Range("A2:A" & Sheets("Sheet1").Range("B65536").End(xlUp).Row)
   
3.         .FormulaR1C1 = "=trim(RC[1])&trim(RC[2])"
   
4.         .Value = .Value
   
5.     End With
   
6. End Sub

複製代碼

ABK

請教一下!  
依上例 若是要在組合字串的中間加入一個減號"-" , 程式要怎樣修改 ?
如下:
1-橋本
2-高山
3-岡田

准提部林

回復 3# ABK


.FormulaR1C1 = "=trim(RC[1])&""-""&trim(RC[2])"

ABK

回復 4# 准提部林


謝謝准提大 !   OK 了!

ABK

我想沿用這個程式在A欄填入公式 , 用來計算B欄的值是第幾次重複, 但是有錯誤, 請教大大們要如何修正
   或是不填入公式, 可以用程式 直接算出重複第幾次更好。

Sub sheet1_Formula()

With Sheets("sheet1").Range("A2:A" & Sheets("sheet1").Range("B65536").End(xlUp).Row)
        .FormulaR1C1 = "=COUNTIF($B$2:$B" & ROW() & ",B" & Row())-1"   '填入公式

        .Value = .Value
    End With

End Sub

ABK

回復 6# ABK


    更正:  上面的程式是用來計算重複的次數, 不是填入公式。

n7822123

回復 7# ABK


這個方法 "FormulaR1C1"  是R1C1表示法的公式

你原本的公式寫法比較像一般的公式，請用 "Formula"

Excel 很聰明的，只要用VBA在連續範圍填入 範圍內第一格公式就好了~~

其它格公式相當於右拉下拉~

以此範例，只要在範圍內填入 A2需要的公式即可...不用再寫 Row()這種函數

先填入公式再轉值 寫法如下
Sub sheet1_Formula()
Rn& = [sheet1!B65536].End(3).Row
With [sheet1!A2].Resize(Rn - 1)
        .Formula = "=COUNTIF($B$2:$B2,B2)-1"    '填入A2的公式
        .Value = .Value
End With
End Sub

不用Excel工作表函數的VBA寫法
Sub sheet1_VBA()
Dim Arr, Brr, R&, S$
Arr = Range([A2], [B65536].End(3))
For R = 1 To UBound(Arr)
    S = S & "," & Arr(R, 2)
    Brr = Split(Mid(S, 2), ",")
    Arr(R, 1) = UBound(Filter(Brr, Arr(R, 2)))
Next R
Range([A2], [B65536].End(3)) = Arr
End Sub


很顯然~~第一種寫法簡單多了，這要歸功於Excel的聰明

准提部林

回復 6# ABK

字典+陣列, 可解決很多基本需求, 可花些時間學習:
Sub sheet1_VCunt()
Dim Arr, i&, xD, T$
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range([Sheet1!B1], [Sheet1!B65536].End(xlUp))
For i = 2 To UBound(Arr)
    T = Arr(i, 1)
    Arr(i - 1, 1) = Val(xD(T))
    If T <> "" Then xD(T) = xD(T) + 1
Next i
[A2].Resize(UBound(Arr) - 1) = Arr
End Sub

ABK

回復 8# n7822123


    感謝阿龍大 熱心給了兩個程式 !