エクセルVBAの文字列操作について

質問

エクセルVBAの文字列操作について
例えば、[１－１０,12,15-20,22-38]と入っているセルがあるとします。
各数字は","で区切られています。このセルに数を足したり引いたりしたいのです。
例えば、このセルから”5”を引いて[１-4,6-１０,12,15-20,22-38]と表示したり、
"21"を足して[１－１０,12,15-38]と表示したいのですが
どなたかご教授いただけないでしょうか？

回答No.3

DOUGLAS_ · ベストアンサー

#1 DOUGLAS_ です。
＞この煩雑な コーディング をご覧になって、
＞もっと スマート なご回答の付くことを
　もう少し スマート な ヤリカタ が見付かりましたのでお知らせいたします。

　使い方は、#1 と同じです。

Function NUMORDER(myStr As String, num As Integer) As String
　Dim strRng As Range
　Dim myRng As Range

'文字列を セルアドレス に変換
　myStr = "$A" & myStr
　myStr = Replace(myStr, " ", "")
　myStr = Replace(myStr, "-", ":$A$")
　myStr = Replace(myStr, ",", ",$A$")

'アドレス を Range オブジェクト に代入し
'「数を足した」場合は、Union メソッド で セル範囲 の集合を求める
　Set strRng = Range(myStr)
　If num > 0 Then
　　Set myRng = Application.Union(Range("$A$" & num), strRng)

'「数を引いた」場合は Intersect メソッド で共有セル範囲を求める
　Else
　　Set strRng = strRng.Offset(1)
　　num = num - 1
　　Set myRng = Application.Intersect(strRng, _
　　　Application.Union(Range("$A$1:$A$" & -num - 1), _
　　　　Range("$A$" & -num + 1 & ":$A$" & Rows.Count)))
　　If myRng Is Nothing Then Exit Function
　　Set myRng = myRng.Offset(-1)
　End If

'求められた セル範囲 の アドレス を文字列に変換
　myStr = myRng.Address
　myStr = Replace(myStr, "$", "")
　myStr = Replace(myStr, "A", "")
　NUMORDER = Replace(myStr, ":", "-")
End Function

お礼

ありがとうございます！解決しました。

回答No.4

Wendy02

=SERIALCHECKER(F1,TRUE,11,13,21)　
TRUE の場合は、加える、FALSE は、引く,
AddVal は、30個まで可能、しかし、数値に限ります。区切りは、[,]カンマ

'---
Public Function SerialChecker(ByVal Nums As Variant, EraseFlg As Boolean, ParamArray AddVal())
'EraseFlg[True-数値をリストに加える,False -抜く,AddVal 加える数列
Dim arNum As Variant
Dim arTmp As Variant
Dim Ar() As Long
Dim Ar2() As Long
Dim i As Long, j As Long, k As Long
Dim n As Variant, c As Variant, ret As Variant
Dim a As Long, b As Long
Dim arBuf As Variant
Dim buf As String
Dim flg As Boolean
Const blDOUBLE As Boolean = True '使われていない
If IsNumeric(Nums) Then Exit Function
Nums = StrConv(Nums, vbNarrow)

If Nums Like "[[]#*" Then
　　Nums = Mid(Nums, 2, Len(Nums) - 2)
End If
arNum = Split(Nums, ",")
For Each n In arNum
　　If InStr(n, "-") Then
　　　　arTmp = Split(n, "-")
　　　　If arTmp(1) > arTmp(0) Then
　　　　　　a = arTmp(0)
　　　　　　b = arTmp(1)
　　　　Else
　　　　　　a = arTmp(1)
　　　　　　b = arTmp(0)
　　　　End If
　　　　For i = a To b
　　　　　　ReDim Preserve Ar(j)
　　　　　　Ar(j) = i
　　　　　　j = j + 1
　　　　Next
　　Else
　　　　ReDim Preserve Ar(j)
　　　　Ar(j) = n
　　　　j = j + 1
　　End If
Next n
If IsArray(AddVal) Then
　　arBuf = Array(AddVal)
End If
If EraseFlg Then 'Add
　　For Each c In AddVal
　　　　ReDim Preserve Ar(j)
　　　　Ar(j) = c
　　　　j = j + 1
　　Next
　　ReDim Ar2(j - 1)
　　For i = 0 To j - 1
　　　　Ar2(i) = Application.Small(Ar, i + 1)
　　Next
Else 'Erase
　　For Each c In Ar
　　　　ret = Application.Match(c, arBuf, 0)
　　　　If IsError(ret) Then
　　　　　　ReDim Preserve Ar2(j)
　　　　　　Ar2(j) = c
　　　　　　j = j + 1
　　　　End If
　　Next
　　For i = 0 To j - 1
　　　　Ar2(i) = Application.Small(Ar2, i + 1)
　　Next
End If
'--
'ダブリを抜くコード省略
'--
buf = Ar2(0)
For i = 1 To j - 1
　　If Ar2(i) = Ar2(i - 1) + 1 Then
　　　　flg = True
　　ElseIf flg Then
　　　　buf = buf & "-" & Ar2(i - 1) & "," & Ar2(i)
　　　　flg = False
　　ElseIf Ar2(i) <> Ar2(i - 1) Then
　　　　buf = buf & "," & Ar2(i)
　　　　flg = False
　　End If
Next
If flg Then buf = buf & "-" & Ar2(i - 1)
SerialChecker = buf
End Function

回答No.2

mt2008

読み取り方次第でどうとでも読み取れる例は止めてください。混乱します。

セルに入っているのは「1,2,3,4,5,6,7,8,9,10,12,15,16,17,18,19,20,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38」と言う文字列？
そうだと仮定して、

5を取るサンプル
Sub Sample1()
　Range("A1") = Replace(Range("A1"), ",5,", ",")
End Sub

21を20の後に追加するサンプル
Sub Sample2()
　Range("A1") = Replace(Range("A1"), ",20,", ",20,21,")
End Sub

回答No.1

DOUGLAS_

＞[１－１０,12,15-20,22-38]と入っているセルがあるとします。
＞各数字は","で区切られています。
とのことですが、「1,2,3,4,5,6,7,8,9,10,12,15,16,17,18,19,20,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38」と入力された セル がある、ということでしょうか？ それとも、正味「1-10,12,15-20,22-38」と入力されているのでしょうか？
　読んだままですと後者の方になりますので、後者の方で考えてみます。

　いずれにいたしましても、何の用途かは存じませんが、「後からこうでした」みたいな追加ご質問にはお応えいたしかねますので、参考までにご覧ください。

　A1 セル に「1-10,12,15-20,22-38」と入力されているとして、別のセルに
=NUMORDER(A1,-5)
と入力すると「1-4,6-10,12,15-20,22-38」と表示し
=NUMORDER(A1,21)
と入力すると「1-10,12,15-38」と表示します。

　１つ目の引数には「セル番地」または「文字列」を、２つ目の引数には「1 ～ 99 までの整数」をお入れください。

　この煩雑な コーディング をご覧になって、もっと スマート なご回答の付くことをお祈り申します。

Function NUMORDER(myStr As Variant, num As Integer) As String
　Dim i As Long
　Dim j As Double
　Dim myNum As Variant

'文字列中の スペース を削除
　myStr = Replace(myStr, " ", "")

'文字列の前後に「0」・「100」を挿入
　Select Case Left(myStr, 2)
　　Case "1,", "1-"
　　　myStr = myStr & ",100"
　　Case Else
　　　myStr = "0," & myStr & ",100"
　End Select

'文字列を カンマ で分割し、ハイフン の区間の数字を補完する
　myStr = Split(myStr, ",")
　For i = 0 To UBound(myStr)
　　If InStr(myStr(i), "-") > 0 Then
　　　myNum = Split(myStr(i), "-")
　　　myStr(i) = ""
　　　For j = myNum(0) To myNum(1)
　　　　myStr(i) = myStr(i) & " " & j
　　　Next
　　　myStr(i) = Trim(myStr(i))
　　End If
　Next

'欠番に「●」を入れ、「数を足したり引いたり」する
　myStr = Split(Join(myStr))
　For i = 0 To UBound(myStr) - 1
　　myStr(i) = myStr(i) & Application.WorksheetFunction.Rept(" ●", myStr(i + 1) - myStr(i) - 1)
　Next
　myStr = Split(Join(myStr))
　If num > 0 Then
　　myStr(num - myStr(0)) = num
　Else
　　myStr(-num - myStr(0)) = "●"
　End If

'前後に挿入した「0」・「100」を削除
　myStr = Replace(Join(myStr), " 100", "")
　If Left(myStr, 2) = "0 " Then myStr = Right(myStr, Len(myStr) - 2)

'連続数字を ハイフン で繋ぐ
　myStr = Split(myStr, "●")
　For i = 0 To UBound(myStr)
　　If myStr(i) <> " " Then
　　myNum = Split(Trim(myStr(i)))
　　　If UBound(myNum) > 0 Then
　　　　myStr(i) = myNum(0) & "-" & myNum(UBound(myNum))
　　　End If
　　End If
　Next

'カンマ で文字列に分割する
　myStr = Application.Trim(Join(myStr))
　NUMORDER = Replace(myStr, " ", ",")
End Function