- 帖子
- 1018
- 主題
- 15
- 精華
- 0
- 積分
- 1058
- 點名
- 0
- 作業系統
- win7 32bit
- 軟體版本
- Office 2016 64-bit
- 閱讀權限
- 50
- 性別
- 男
- 來自
- 桃園
- 註冊時間
- 2012-5-9
- 最後登錄
- 2022-9-28
|
4#
發表於 2014-2-19 20:42
| 只看該作者
回復 1# q1a2z5 - Sub Test()
- Dim sA As String, sB As String, sM As String, sRslt As String
- Dim rngA, rngRslt As Range
-
- Set rngA = Range("J4:M4") '範圍或位置只要改這裡就好
-
- sA = Join(Application.Transpose(Application.Transpose(rngA.Value)), "")
- sB = Join(Application.Transpose(Application.Transpose(rngA.Offset(1).Value)), "")
-
- '清除之前的結果
- With rngA
- With .Offset(2, -.Count).Resize(.Count + 1, 2 * .Count)
- .ClearContents
- .Borders(xlInsideHorizontal).LineStyle = xlContinuous
- .Borders(xlInsideHorizontal).LineStyle = xlNone
- End With
- End With
-
- '計算過程
- For i = 1 To Len(sB)
- sM = CStr(CLng(Mid(sB, Len(sB) - i + 1, 1)) * CLng(sA))
- With rngA.Resize(, rngA.Count + 1).Offset(1 + i, -i)
- For j = 1 To Len(sM)
- .Cells(.Count - j + 1).Value = Mid(sM, Len(sM) - j + 1, 1)
- Next
- If i = 1 Then .Borders(xlEdgeTop).LineStyle = xlContinuous
- End With
- Next
-
- '計算結果
- sRslt = CStr(CLng(sA) * CLng(sB))
- Set rngRslt = rngA.Offset(2 + Len(sB), -Len(sB)).Resize(, Len(sA) + Len(sB))
- With rngRslt
- .Borders(xlEdgeTop).LineStyle = xlContinuous
- For i = 1 To Len(sRslt)
- .Cells(.Count - i + 1).Value = Mid(sRslt, Len(sRslt) - i + 1, 1)
- Next
- End With
- End Sub
|
|
發表於 2014-2-19 23:10
| 