こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

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

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

投稿日時 - 2010-04-22 19:49:56

QNo.5844338

すぐに回答ほしいです

質問者が選んだベストアンサー

#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

投稿日時 - 2010-04-23 18:29:18

お礼

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

投稿日時 - 2010-04-30 22:00:31

このQ&Aは役に立ちましたか?

4人が「このQ&Aが役に立った」と投票しています

回答(4)

ANo.4

=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

投稿日時 - 2010-04-23 23:30:23

ANo.2

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

セルに入っているのは「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

投稿日時 - 2010-04-23 11:00:49

ANo.1

>[1-10,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つ目の引数には「セル番地」または「文字列」を、2つ目の引数には「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

投稿日時 - 2010-04-22 23:36:19

あなたにオススメの質問