麻辣家族討論版版 - Powered by Discuz! Board

Dim x,i As Integer
x = (Len(Mid(Cells(1, 2), 3)))/2 '計算共有幾個兩個一組
For i = 1 To x '要做的次數
要請前輩幫忙的地方
Next

複製代碼

Sub yy()
Dim x$, w$, i%, j%
For j = 1 To [b65536].End(3).Row
w = Mid(Cells(j, 2), 3)
For i = Len(w) To 2 Step -2
x = IIf(x = "", Mid(w, i - 1, 2), x & "-" & Mid(w, i, 2))
Next
Cells(j, 3) = x
x = ""
Next
End Sub

複製代碼

Sub nn()
Dim ar()
For Each a In Range([B1], [B1].End(xlDown))
For i = Len(Split(a, "x")(1)) - 1 To 1 Step -2
ReDim Preserve ar(s)
ar(s) = Mid(Split(a, "x")(1), i, 2)
s = s + 1
Next
a.Offset(, 1) = Join(ar, "-")
Erase ar
s = 0
Next
End Sub

複製代碼

Option Explicit
Sub Ex()
Dim AR(1), i As Integer, ii As Integer, s As String
With Range([B1], [B1].End(xlDown)) '資料範圍
AR(0) = .Value '資料置入陣列
.Replace "*x", "", LookAt = xlPart '不要的資料取代為""字串
AR(1) = .Value '整理後的資料置入陣列
.Value = AR(0) '還原原本資料
For i = 1 To UBound(AR(1)) '整理後的資料的陣列
s = "" '清空字串變數
For ii = Len(AR(1)(i, 1)) To 1 Step -2 '由字串尾端
s = s & "-" & Mid(AR(1)(i, 1), ii - 1, 2) '取二字元置入字串變數
Next
AR(1)(i, 1) = Mid(s, 2) '陣列的元素=字串變數
Next
.Offset(, 1) = AR(1) '資料範圍向右位移一欄範圍資料=AR(1)
End With
End Sub
Sub Ex1()
Dim AR, i As Integer, ii As Integer, xi As Variant, s As String
With Range([B1], [B1].End(xlDown)) '資料範圍
AR = .Value '資料置入陣列
For i = 1 To UBound(AR)
xi = InStr(AR(i, 1), "x") + 1 '陣列的元素中尋找"x"
xi = Mid(AR(i, 1), xi) '取得正確資料
s = "" '清空字串變數
For ii = Len(xi) To 1 Step -2 '由字串尾端
s = s & "-" & Mid(xi, ii - 1, 2) '取二字元置入字串變數
Next
AR(i, 1) = Mid(s, 2) '陣列的元素=字串變數
Next
.Offset(, 1) = AR '資料範圍向右位移一欄範圍資料=AR
End With
End Sub
Sub Ex2()
Dim AR, i As Integer, ii As Integer, s As String
With Range([B1], [B1].End(xlDown)) '資料範圍
AR = .Value '資料置入陣列
For i = 1 To .Cells.Count '資料範圍的第一個儲存格到最後一個儲存格
ii = Len(.Cells(i)) '計算儲存格的字元數
s = "" '清空字串變數
Do
s = s & "-" & Mid(.Cells(i), ii - 1, 2) '取二字元置入字串變數
ii = ii - 2 '由後往前推進2字元
Loop Until InStr(Mid(.Cells(i), ii - 1, 2), "x") '離開迴圈條件:找到不要的字串
AR(i, 1) = Mid(s, 2) '陣列的元素=字串變數
Next
.Offset(, 1) = AR '資料範圍向右位移一欄範圍資料=AR
End With
End Sub

複製代碼