Option Explicit
Sub TEST()
Dim Brr, V, Z&, i, j&, xR As Range
Set xR = Range([A17], Cells(Rows.Count, "A").End(xlUp)): Brr = xR
With xR.Offset(0, 1)
.Value = Brr
For Each i In Array("*(", ")*", " "): .Replace i, "", 2: Next
For i = 65 To 122: .Replace Chr(i), "", 2: Next
Brr = .Value
End With
For i = 1 To UBound(Brr)
V = Split(Brr(i, 1), ",")
For j = 0 To UBound(V)
If InStr(V(j), "-") Then
Z = Z + Abs(Evaluate("=" & V(j))) + 1
ElseIf V(j) <> "" Then
Z = Z + 1
End If
Next
Brr(i, 1) = Z: Z = 0
Next
xR.Offset(0, 1) = Brr
Set xR = Nothing: Erase Brr, V
End Sub作者: PJChen 時間: 2023-4-17 16:41
Option Explicit
Sub TEST()
Dim Brr, V, i, j&, Z&, xR As Range
'↑宣告變數:(Brr,V,i)是通用型變數,(j,Z)是長整數,xR是儲存格變數
Set xR = Range([A17], Cells(Rows.Count, "A").End(xlUp)): Brr = xR
'↑令xR這儲存格變數是 [A17]到 A欄最後一個有內容儲存格,
'令Brr這通用型變數是 二維陣列,以xR變數(儲存格)值帶入
With xR.Offset(0, 1)
'↑以下是關於xR變數向右偏移一欄的程序
.Value = Brr
'↑令其儲存格值是 Brr陣列值
For Each i In Array("*(", ")*", " "): .Replace i, "", 2: Next
'↑設逐項迴圈,令i這通用型變數是 一維陣列中的一個字串
'令該範圍儲存格做字元置換,先將左括弧"(" 左邊的字元都換成空字元
'再將右括弧")" 右邊的字元都換成空字元
'最後將空白字元都換成空字元
For i = 65 To 122: .Replace Chr(i), "", 2: Next
'↑設順迴圈!i從65 到122
'令該範圍儲存格做字元置換從A,B,C,D....做置換成空字元,Chr(65)="A"
', 2是指儲存格裡字串部分相同就做置換,不需要字串全部相同才置換
Brr = .Value
'↑令Brr這通用型變數換裝上述這些迴圈的儲存格結果值
End With
For i = 1 To UBound(Brr)
'↑設順迴圈!i從1 到Brr縱向最大索引列號
V = Split(Brr(i, 1), ",")
'↑令V這通用型變數是一維陣列,以i迴圈列1欄Brr陣列值被","分割後的值
For j = 0 To UBound(V)
'↑設順迴圈!j從0 到V陣列最大索引號數
If InStr(V(j), "-") Then
'↑如果j迴圈V陣列值包含"-"符號??
Z = Z + Abs(Evaluate("=" & V(j))) + 1
'↑就令Z這長整數變數是 自身 + 計算值
'計算值:j迴圈V陣列值在前面加個"="之後做運算
'例如:Evaluate("=2-14") =-12
'Abs(-12)=12 :是絕對值,讓值都變正數的意思,
'最後按照範例意義 +1
ElseIf V(j) <> "" Then
'↑否則如果j迴圈V陣列值不是空字元?
Z = Z + 1
'↑就令Z變數累加 1
End If
Next
Brr(i, 1) = Z: Z = 0
'↑令i迴圈列第1欄Brr陣列值是 變數Z,
'↑令Z變數是 0 (因為要跑i的下一個迴圈了,所以要讓Z歸零重算)
Next
xR.Offset(0, 1) = Brr
'↑令xR變數向右偏移一欄,這範圍儲存格值以Brr陣列值帶入
Set xR = Nothing: Erase Brr, V
'↑令釋放這些變數
End Sub作者: Andy2483 時間: 2023-4-18 08:56
自訂函數//
Function GetSerial(ST$)
Dim a, Tr, V1%, V2%, S%
If InStr(ST, "(") = 0 Then ST = "(" & ST
ST = Split(Replace(ST, ")", ""), "(")(1)
For Each a In Split(ST, ",")
Tr = Split(a & "-" & a, "-")
V1 = Val(StrReverse(Mid(Val(StrReverse(Tr(0) & 1)), 2)))
V2 = Val(StrReverse(Mid(Val(StrReverse(Tr(1) & 1)), 2)))
If V1 + V2 <> 0 Then S = S + Abs(V2 - V1) + 1
Next a
If S > 0 Then GetSerial = S Else GetSerial = ""
End Function
'自訂函數//
Function GetSerial(ST$)
'↑自訂函數_GetSerial,ST變數是字串變數(儲存格裡的值是文字)
Dim a, Tr, V1%, V2%, S%
'↑宣告變數(a,Tr)是通用型變數,(V1,V2,S)是短整數
If InStr(ST, "(") = 0 Then ST = "(" & ST
'↑如果ST這字串變數裡不包含 "(" 符號!,
'就令其前方多一個 "("符號組成新字串
ST = Split(Replace(ST, ")", ""), "(")(1)
'↑令先將ST變數裡的 ")" 符號置換成空字元,
'之後再將ST變數用 "("分割成一維陣列取索引號1的字串
For Each a In Split(ST, ",")
'↑設逐項迴圈!令a這通用型變數是 ST變數被","分割成一維陣列的一陣列值
Tr = Split(a & "-" & a, "-")
'↑令Tr這通用型變數是 a變數連接"-",再連接a變數後,
'以"-"分割成為一維陣列
V1 = Val(StrReverse(Mid(Val(StrReverse(Tr(0) & 1)), 2)))
'↑令V1變數是 先將Tr 0索引號陣列值裡的字元反轉,取前面數值後,
'再將這數值字元反轉回來,這樣的方式就會只抓取到前方數字的字元 https://learn.microsoft.com/zh-t ... strreverse-function
V2 = Val(StrReverse(Mid(Val(StrReverse(Tr(1) & 1)), 2)))
'↑令V2與類推與V1相同方式取得前方數字字元
If V1 + V2 <> 0 Then S = S + Abs(V2 - V1) + 1
'↑如果V1變數+V2變數 不等於0 ,就讓S這短整數變數是自身+絕對值(V1變數+V2變數)+1
Next a
If S > 0 Then GetSerial = S Else GetSerial = ""
'↑如果S變數>0 !就令GetSerial函數回傳 S變數值,否則就回傳空字元
End Function
=================
後學尚有一些細節不了解,繼續累積經驗,謝謝前輩作者: PJChen 時間: 2023-4-24 19:05
准大好,
請教自定義 Function GetSerial(ST$),程式與要計算的檔案放在一起,就可以計算,
但因為我是把程式與計算檔分開存放,但我做了指定仍是無作用??
Function GetSerial(ST$)
Dim Sh As Worksheet, W As Workbook
Set W = Workbooks("出貨文件_PO.xlsx"): Set Sh = W.Sheets("箱號計算"): Sh.Activate
Dim a, Tr, V1%, V2%, S%
If InStr(ST, "(") = 0 Then ST = "(" & ST
ST = Split(Replace(ST, ")", ""), "(")(1)
For Each a In Split(ST, ",")
Tr = Split(a & "-" & a, "-")
V1 = Val(StrReverse(Mid(Val(StrReverse(Tr(0) & 1)), 2)))
V2 = Val(StrReverse(Mid(Val(StrReverse(Tr(1) & 1)), 2)))
If V1 + V2 <> 0 Then S = S + Abs(V2 - V1) + 1
Next a
If S > 0 Then GetSerial = S Else GetSerial = ""
End Function