ここから本文です

エクセルのデータを割付して利用しようとした時に、「D10 ~ D25」と入力されてい...

アバター

ID非公開さん

2019/5/2522:49:35

エクセルのデータを割付して利用しようとした時に、「D10 ~ D25」と入力されていて、「~」で省略されている部分が利用出来ません。
仕方がないので現状では、手入力で変換してから割付してい

ます。
「~」表記部のデータが、複数有ったり、範囲が広いと手入力が大変で間違いそうです。

マクロで「~」で省略表記されている部分を連番で表記するようなことは、出来ないのでしょうか?

補足簡単に下記のようにデータ変換出来る様にしたいです。

元データ 変更後データ
C1,C3,C6~C10 → C1,C3,C6,C7,C8,C9,C10
R20~R30 → R20,R21,R22,R23,R24,R25,R26,R27,R28,R29,R30

閲覧数:
81
回答数:
2
お礼:
100枚

違反報告

ベストアンサーに選ばれた回答

30246kikuさん

2019/5/2609:42:24

雰囲気、以下でどうなりますか

文字列を作る部分になりますが、その後どうする???わかっていないので

標準モジュールに以下を記述して、確認用 Samp1 を実行してみます
処理本体は、fncSamp1

※ 数字部分 0 は特別扱いしているので、1 ~ ということで・・・
C0~C3 → C1,C2,C3 にしているとか・・・

処理的におかしなところあれば、変更してみてください
文字・数字分離で、現状常に True にしているところとか・・・・
連続 ~ 後の文字は使っていないとか・・・ A2~B5 → A2~A5 扱い・・・

一応、表示される結果は以下の様になると思います

C1,C3,C6~C10
C1,C3,C6,C7,C8,C9,C10

R20~R30
R20,R21,R22,R23,R24,R25,R26,R27,R28,R29,R30

C1,C3 , C6-10
C1,C3,C6,C7,C8,C9,C10

A1,A12~A15,A8,A6~A9
A1,A6,A7,A8,A9,A12,A13,A14,A15

C1,C3,C6~C10~C8,D2-D4,A3~A6
A3,A4,A5,A6,C1,C3,C6,C7,C8,D2,D3,D4

1,6,4~7,12-16, C2-4, A7
1,4,5,6,7,12,13,14,15,16,A7,C2,C3,C4

D,F,A,B3-B7,C0-C3
A,B3,B4,B5,B6,B7,C1,C2,C3,D,F

C10 ~ 6 ,,C3,A2-B5
A2,A3,A4,A5,C3,C6,C7,C8,C9,C10

-D3,B-3,E4~,~
B1,B2,B3,D3,E4,~

---

Option Explicit

Public Sub Samp1()
   Dim vC As Variant, v As Variant
   Dim sS As String

   vC = Array( _
         "C1,C3,C6~C10", _
         "R20~R30", _
         "C1,C3 , C6-10", _
         "A1,A12~A15,A8,A6~A9", _
         "C1,C3,C6~C10~C8,D2-D4,A3~A6", _
         "1,6,4~7,12-16, C2-4, A7", _
         "D,F,A,B3-B7,C0-C3", _
         "C10 ~ 6 ,,C3,A2-B5", _
         "-D3,B-3,E4~,~" _
      )

   sS = ""
   For Each v In vC
      sS = sS & v & vbCrLf
      sS = sS & fncSamp1(v) & vbCrLf & vbCrLf
   Next
   Debug.Print sS
   MsgBox sS
End Sub

Public Function fncSamp1(ByVal sSrc As String) As String
   Dim dic As Object, dicW As Object
   Dim vA As Variant, vK As Variant, v As Variant
   Dim sS As String
   Dim sA(0 To 1) As String, jA(0 To 1) As Long, bA(0 To 1) As Boolean
   Dim i As Long, j As Long, k As Long
   Const CMM As String = "~-"
   Const CP As String = ","

   Set dic = CreateObject("Scripting.Dictionary")

   sSrc = Replace(sSrc, " ", "", , , vbTextCompare)
   For Each v In Split(sSrc, CP, , vbTextCompare)
      If (v <> "") Then
         Erase sA, jA, bA
         For i = 1 To Len(CMM)
            vA = Split(v, Mid(CMM, i, 1), , vbTextCompare)
            If (UBound(vA) > 0) Then Exit For
         Next
         Select Case UBound(vA)
            Case 0
               bA(0) = fncAZnum(vA(0), sA(0), jA(0))
               sA(1) = sA(0)
               jA(1) = jA(0)
               bA(1) = bA(0)
            Case Else
               vA(1) = vA(UBound(vA))
               If (vA(0) = "") Then vA(0) = vA(1)
               If (vA(1) = "") Then vA(1) = vA(0)
               If (vA(0) <> "") Then
                  bA(0) = fncAZnum(vA(0), sA(0), jA(0))
                  bA(1) = fncAZnum(vA(1), sA(1), jA(1))
               End If
         End Select
         If (bA(0) And bA(1)) Then
            If (Not dic.Exists(sA(0))) Then
               dic.Add sA(0), CreateObject("Scripting.Dictionary")
            End If
            Set dicW = dic(sA(0))
            j = jA(0)
            If (jA(1) > jA(0)) Then
               k = jA(1)
            Else
               j = jA(1)
               k = jA(0)
            End If
            If ((j = 0) And (k = 0)) Then
               dicW(0) = Empty
            Else
               If (j = 0) Then j = 1
               For i = j To k
                  dicW(i) = Empty
               Next
            End If
         Else
            If (Not dic.Exists(v)) Then
               dic.Add v, CreateObject("Scripting.Dictionary")
               dic(v)(0) = Empty
            End If
         End If
      End If
   Next

   sS = ""
   If (dic.Count > 0) Then
      For Each vK In mySort(dic.Keys)
         Set dicW = dic(vK)
         For Each v In mySort(dicW.Keys)
            If (v = 0) Then
               sS = sS & CP & vK
            Else
               sS = sS & CP & vK & v
            End If
         Next
      Next
      sS = Mid(sS, Len(CP) + 1)
   End If
   fncSamp1 = sS

   Set dic = Nothing
   Set dicW = Nothing
End Function

Private Function fncAZnum(ByVal sSrc As String _
               , sA As String, jA As Long) As Boolean
   Dim i As Long

   For i = Len(sSrc) To 1 Step -1
      If (Mid(sSrc, i, 1) Like "[!0-9]") Then Exit For
   Next
   sA = Left(sSrc, i)
   jA = Val(Mid(sSrc, i + 1))
   fncAZnum = True
End Function

Private Function mySort(ByVal vA As Variant) As Variant
   Dim v As Variant
   Dim i As Long, k As Long

   k = UBound(vA)
   Do
      v = Empty
      For i = LBound(vA) To k - 1
         If (vA(i) > vA(i + 1)) Then
            v = vA(i)
            vA(i) = vA(i + 1)
            vA(i + 1) = v
            k = i
         End If
      Next
   Loop While (Not IsEmpty(v))
   mySort = vA
End Function

  • アバター

    質問者

    ID非公開さん

    2019/5/2615:47:05

    ありがとうございます。
    サンプル処理の結果は、確認できましたが、選択したセルの内容を処理結果のデータに置き換えする様にしたいのですが、どの部分を変更したらよいのでしょうか?

  • その他の返信(5件)を表示

返信を取り消しますが
よろしいですか?

  • 取り消す
  • キャンセル

アバター

質問した人からのコメント

2019/6/1 12:25:24

助かりました!
ありがとうございます!

ベストアンサー以外の回答

1〜1件/1件中

tok********さん

2019/5/2608:48:37

文字列を取得したいという事ならば、自分だったらオートフィルを使います。
というか、D10~D25ならばD10:D25と指定すればいいと思うんですが、不都合ですか?

あわせて知りたい

この質問につけられたタグ

みんなで作る知恵袋 悩みや疑問、なんでも気軽にきいちゃおう!

Q&Aをキーワードで検索:

Yahoo! JAPANは、回答に記載された内容の信ぴょう性、正確性を保証しておりません。
お客様自身の責任と判断で、ご利用ください。
本文はここまでです このページの先頭へ

「追加する」ボタンを押してください。

閉じる

※知恵コレクションに追加された質問は選択されたID/ニックネームのMy知恵袋で確認できます。

不適切な投稿でないことを報告しました。

閉じる