Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

1681 / 13646 ﾂﾘｰ

←次へ　｜　前へ→

▼

【72658】＜を含む言葉を抜き出す おにこ 12/8/31(金) 16:22

【72661】Re:＜を含む言葉を抜き出す ドカ 12/8/31(金) 17:32

【72662】Re:＜を含む言葉を抜き出す ドカ 12/8/31(金) 17:41

【72665】Re:＜を含む言葉を抜き出す ドカ 12/8/31(金) 19:40

【72668】Re:＜を含む言葉を抜き出す UO3 12/8/31(金) 23:12

【72677】Re:＜を含む言葉を抜き出す おにこ 12/9/3(月) 9:41

【72663】Re:＜を含む言葉を抜き出す kanabun 12/8/31(金) 19:21

【72667】Re:＜を含む言葉を抜き出す kanabun 12/8/31(金) 19:58

【72669】Re:＜を含む言葉を抜き出す Yuki 12/9/1(土) 11:43

【72673】Re:＜を含む言葉を抜き出す kanabun 12/9/1(土) 23:57

【72674】Re:＜を含む言葉を抜き出す Yuki 12/9/2(日) 8:54

【72678】Re:＜を含む言葉を抜き出す おにこ 12/9/3(月) 9:42

【72676】Re:＜を含む言葉を抜き出す kanabun 12/9/2(日) 21:04

【72679】Re:＜を含む言葉を抜き出す おにこ 12/9/3(月) 9:44


	【72658】＜を含む言葉を抜き出す

おにこ - 12/8/31(金) 16:22 -


	引用なし

	パスワード

列AAに

たぬき＜みどり＞、きつね
きつね、たぬき
たぬき＜赤＞、きつね＜茶色＞
たぬき、きつね＜みどり＞

とあります。

「＜＞」を含む言葉がある場合、AH列に「＜＞」を含む言葉を移動させたいです。

たぬき＜みどり＞、きつね⇒AA列：きつね　AH列：たぬき＜みどり＞
きつね、たぬき⇒AA列：きつね、たぬき
たぬき＜赤＞、きつね＜茶色＞⇒AA列：（空欄）　AH列：たぬき＜赤＞、きつね＜茶色＞
たぬき、きつね＜みどり＞⇒AA列：たぬき　　AH列：きつね＜みどり＞

にしたいです。

どのようにVBAを作成したらよいのでしょうか


	【72661】Re:＜を含む言葉を抜き出す

ドカ - 12/8/31(金) 17:32 -


	引用なし

	パスワード

▼おにこさん：

こんなことでしょうか？
上から順にﾏｸﾛを実施してください。

Sub ﾃﾞｰﾀ分解()

　　Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
　　　　TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
　　　　Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
　　　　:="、", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
End Sub

Sub 探す()

For n = 1 To 10
p = 0
p1 = 0
　　
　　For i = 1 To 10
　　　　If Cells(n, i) <> "" Then
　　　　　　If Cells(n, i).Value Like "*＜*" Then
　　　　　　　　Cells(n, 33 + p) = Cells(n, i)
　　　　　　　　p = p + 1
　　　　　　Else
　　　　　　　　Cells(n, 27 + p1) = Cells(n, i)
　　　　　　　　p1 = p1 + 1
　　　　　　End If
　　　　Else
　　　　　　Exit For
　　　　End If
　　Next
Next
End Sub

Sub 結合()
For n = 1 To 10
　　For i = 1 To 5
　　　　If Cells(n, 27 + i) <> "" Then
　　　　　　Cells(n, 27) = Cells(n, 27) & "、" & Cells(n, 27 + i)
　　　　　　Cells(n, 27 + i) = ""
　　　　End If
　　Next
Next

For n = 1 To 10
　　For i = 1 To 5
　　　　If Cells(n, 33 + i) <> "" Then
　　　　　　Cells(n, 33) = Cells(n, 33) & "、" & Cells(n, 33 + i)
　　　　　　Cells(n, 33 + i) = ""
　　　　End If
　　Next
Next
End Sub


	【72662】Re:＜を含む言葉を抜き出す

ドカ - 12/8/31(金) 17:41 -


	引用なし

	パスワード

>▼おにこさん：

よく読まずに、A列にあるとして、ﾃﾞｰﾀを移動するﾏｸﾛを書いてしまいました。
後はご自分で対応できるならよろしくお願いします。


	【72663】Re:＜を含む言葉を抜き出す

kanabun - 12/8/31(金) 19:21 -


	引用なし

	パスワード

▼おにこさん：語と語の区切りは「、」ですか？だとして、（元）　　AA列たぬき＜みどり＞、きつねきつね、たぬきたぬき＜赤＞、きつね＜茶色＞たぬき、きつね＜みどり＞（移動後）　　AA列　　　　　　　　　　　　　AH列きつね　　　　　　　　　　　　　たぬき＜みどり＞きつね、たぬき　　　　　　　　　　　　　　　　たぬき＜赤＞、きつね＜茶色＞たぬき　　　　　　　　　　　　　きつね＜みどり＞となればいいのですか？ Sub Try2() 　　Dim r As Range, c As Range 　　Dim ss As String, aa, ah 　　Dim i As Long 　　Dim List1 As Object 　　Dim List2 As Object 　　Set List1 = CreateObject("Forms.Combobox.1") 　　Set List2 = CreateObject("Forms.Combobox.1") 　　　　For Each c In Range("AA1", Cells(Rows.Count, "AA").End(xlUp)) 　　　　ss = c.Value 　　　　If InStr(ss, "＜") > 0 Then 　　　　　　aa = Split(ss, "、") 'セルの文字列を「、」で分割　　　　　　List1.List = aa 　　　　　　List2.List = aa 　　　　　　With List1 　　　　　　　　For i = .ListCount - 1 To 0 Step -1 　　　　　　　　　　If .List(i) Like "*＜*＞*" Then 　　　　　　　　　　　　.RemoveItem i 　　　　　　　　　　Else 　　　　　　　　　　　　List2.RemoveItem i 　　　　　　　　　　End If 　　　　　　　　Next 　　　　　　End With 　　　　　　aa = "" 　　　　　　ah = "" 　　　　　　Select Case List1.ListCount 　　　　　　　Case Is = 1: aa = List1.List(0) 　　　　　　　Case Is > 1: aa = Join(Application.Transpose(List1.List), "、") 　　　　　　End Select 　　　　　　Select Case List2.ListCount 　　　　　　　Case Is = 1: ah = List2.List(0) 　　　　　　　Case Is > 1: ah = Join(Application.Transpose(List2.List), "、") 　　　　　　End Select 　　　　　　c.Value = aa 　　　　　　c.Offset(, 7).Value = ah 　　　　End If 　　Next 　　　　 End Sub


	【72665】Re:＜を含む言葉を抜き出す

ドカ - 12/8/31(金) 19:40 -


	引用なし

	パスワード

>>▼おにこさん　
また時間ができたので、やっておきました。

私のマクロは、他の皆さんと違って、基本的なことさえ知っていれば、作れるコードで書いています。マクロの記録などもそのまま使っています。
それでも動くことがVBAの最大のメリットではないのかな？
ただし、処理速度が遅くて使いものにならない時は、別途スマートなコードが必要です。

Sub Macro4()
　　シート名 = ActiveSheet.Name
　　ActiveSheet.Copy Before:=Sheets(1)

　　シート名1 = ActiveSheet.Name
　　Columns("A:Z").Select
　　Selection.Delete Shift:=xlToLeft
　　

'データ分解()
　　
　　Columns("A:A").Select
　　Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
　　　　TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
　　　　Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
　　　　:="、", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True

' 探す()

For n = 1 To 10
p = 0
p1 = 0
　
　　For i = 1 To 10
　　　　If Cells(n, i) <> "" Then
　　　　　　If Cells(n, i).Value Like "*＜*" Then
　　　　　　　　Cells(n, 33 + p) = Cells(n, i)
　　　　　　　　p = p + 1
　　　　　　Else
　　　　　　　　Cells(n, 27 + p1) = Cells(n, i)
　　　　　　　　p1 = p1 + 1
　　　　　　End If
　　　　Else
　　　　　　Exit For
　　　　End If
　　Next
Next

' 結合()
For n = 1 To 10
　　For i = 1 To 5
　　　　If Cells(n, 27 + i) <> "" Then
　　　　　　Cells(n, 27) = Cells(n, 27) & "、" & Cells(n, 27 + i)
　　　　　　Cells(n, 27 + i) = ""
　　　　End If
　　Next
Next

For n = 1 To 10
　　For i = 1 To 5
　　　　If Cells(n, 33 + i) <> "" Then
　　　　　　Cells(n, 33) = Cells(n, 33) & "、" & Cells(n, 33 + i)
　　　　　　Cells(n, 33 + i) = ""
　　　　End If
　　Next
Next

' 貼り付け()
'

　　Columns("AA:AA").Select
　　Selection.Copy

　　Worksheets(シート名).Select

　　Columns("AA:AA").Select
　　ActiveSheet.Paste

　　Worksheets(シート名1).Select
　　Columns("AG:AG").Select
　　Selection.Copy

　　Worksheets(シート名).Select

　　Columns("AG:AG").Select
　　ActiveSheet.Paste

　　Worksheets(シート名1).Delete
End Sub


	【72667】Re:＜を含む言葉を抜き出す

kanabun - 12/8/31(金) 19:58 -


	引用なし

	パスワード

>▼おにこさん： > >語と語の区切りは「、」 >だとして、 > >（元）　　AA列 >たぬき＜みどり＞、きつね > >（移動後） >　　AA列　　　　　　　　　　　　　AH列 >きつね　　　　　　　　　　　　　たぬき＜みどり＞ >となればいいのですか？ > 上のコードでやっていることを図で説明します。 AA列を1行づつ順に処理していきます。　　セルの文字列中に「＜」があったときだけ、移動処理をします。 > 　　　If InStr(ss, "＜") > 0 Then > 　　　　　aa = Split(ss, "、") 'セルの文字列を「、」で分割分割したリストを２つのComboBoxのリストにセットします。　　（このComboBoxは見えません） > 　　　　　List1.List = aa > 　　　　　List2.List = aa 　　　　　List1　　　　　　　　　　　List2　　　　　　┌─────────┐　　　┌─────────┐ 　　　│たぬき＜みどり＞　│　　　│たぬき＜みどり＞　│ 　　　│きつね　　　　　　│　　　│きつね　　　　　　│ 　　　│　　　　　　　　　│　　　│　　　　　　　　　│ 　　　│　　　　　　　　　│　　　│　　　　　　　　　│ 　　　│　　　　　　　　　│　　　│　　　　　　　　　│ 　　　│　　　　　　　　　│　　　│　　　　　　　　　│ 　　　└─────────┘　　　└─────────┘ > 　　　　　With List1 　　　このリストを下から調べていきます。 > 　　　　　　　For i = .ListCount - 1 To 0 Step -1 　　　　　　もし対象リストアイテムに「＜*＞」が含まれていたら > 　　　　　　　　　If .List(i) Like "*＜*＞*" Then 　　　　　　　　List1からそのアイテムを削除します > 　　　　　　　　　　　.RemoveItem i > 　　　　　　　　　Else 　　　　　　　　含まれていなければ、List2のその行を削除します > 　　　　　　　　　　　List2.RemoveItem i > 　　　　　　　　　End If > 　　　　　　　Next > 　　　　　End With この処理がおわると、2つのリストは以下のようになっています　　　　　List1　　　　　　　　　　　List2　　　　　　┌─────────┐　　　┌─────────┐ 　　　│きつね　　　　　　│　　　│たぬき＜みどり＞　│ 　　　│　　　　　　　　 │　　　│　　　　　　　　　│ 　　　│　　　　　　　　　│　　　│　　　　　　　　　│ 　　　│　　　　　　　　　│　　　│　　　　　　　　　│ 　　　│　　　　　　　　　│　　　│　　　　　　　　　│ 　　　│　　　　　　　　　│　　　│　　　　　　　　　│ 　　　└─────────┘　　　└─────────┘ それぞれのリストを（アイテムが複数あれば「、」でJoinして） AA列とAH列に貼り付けます。 > 　　　　　c.Value = aa > 　　　　　c.Offset(, 7).Value = ah


	【72668】Re:＜を含む言葉を抜き出す

UO3 - 12/8/31(金) 23:12 -


	引用なし

	パスワード

▼ドカさん：

こんばんは

>私のマクロは、他の皆さんと違って、基本的なことさえ知っていれば、作れるコードで書いています。マクロの記録などもそのまま使っています。
>それでも動くことがVBAの最大のメリットではないのかな？

ドカさんが回答されるコードを拝見していて、このドカさんの方針といいますか
スタンスは理解していますし、質問者さんは初心者がおおいので、できるだけ
わかりやすいコードにして回答しておられることについては、一理あると考えています。

ただ、やはり、質問者さんは回答者からの回答コードを「模範」として、その後、書いていくコードに
反映していくんだろうなと思います。

そういう意味では、わかりやすいコードというところは異論はありませんが
やはり、Select/Selection や　シートをSelect して　アクティブシートを前提にしたセル記述　等々は
やはり、質問者さんには、一日も早く、そのクセから抜けていただきたいと思っています。
動きが無駄と言うことより、そのことが、往々にしてバグを引き起こす要因になるからです。
（ドカさんのコードではないのですが、セルをSelectしてActiveCellに対して処理をするのもバグの要因になったりしますね）

また、セルを扱う場合はプロパティも明示するように、質問者さんには常々アドバイスをしております。
このことも、重要なことだと、そう思っています。


	【72669】Re:＜を含む言葉を抜き出す

Yuki - 12/9/1(土) 11:43 -


	引用なし

	パスワード

▼おにこさん：
こんにちは。

こんな感じで

Sub TEST()
　　Dim i　　　 As Long
　　Dim j　　　 As Long
　　Dim x　　　 As Long
　　Dim y　　　 As Long
　　Dim v　　　 As Variant
　　Dim v1　　　As Variant
　　Dim S1()　　As String
　　Dim S2()　　As String
　　
　　v = Range("AA1").CurrentRegion.Resize(, 1).Value
　　For i = 1 To UBound(v)
　　　　Erase S1
　　　　Erase S2
　　　　x = 0
　　　　y = 0
　　　　v1 = Split(v(i, 1), "、", , vbTextCompare)
　　　　For j = 0 To UBound(v1)
　　　　　　If InStr(1, v1(j), "＜", vbTextCompare) > 0 And _
　　　　　　　 InStr(1, v1(j), "＞", vbTextCompare) > 0 Then
　　　　　　　　ReDim Preserve S1(x)
　　　　　　　　S1(x) = v1(j)
　　　　　　　　x = x + 1
　　　　　　Else
　　　　　　　　ReDim Preserve S2(y)
　　　　　　　　S2(y) = v1(j)
　　　　　　　　y = y + 1
　　　　　　End If
　　　　Next
　　　　Cells(i, 27).Value = Join(S2, "、")
　　　　Cells(i, 34).Value = Join(S1, "、")
　　Next
End Sub


	【72673】Re:＜を含む言葉を抜き出す

kanabun - 12/9/1(土) 23:57 -


	引用なし

	パスワード

▼Yuki さん： Yuki さんのことですから、↓茶々ですけどゆるしてね >こんな感じで >　　v = Range("AA1").CurrentRegion.Resize(, 1).Value A列～ Z列までデータがあったばあいは、変数v にどの列の値が入るのでしょうか？


	【72674】Re:＜を含む言葉を抜き出す

Yuki - 12/9/2(日) 8:54 -


	引用なし

	パスワード

▼kanabun さん：
>
>>こんな感じで
>>　　v = Range("AA1").CurrentRegion.Resize(, 1).Value
>
>A列～ Z列までデータがあったばあいは、変数v にどの列の
>値が入るのでしょうか？

kanabunさん、どうもです。
最近CurentResionの件で能書きを書いたそのまんまですね。
えらい勘違いです。
v = Range("AA1").CurrentRegion,offset(,26).Resize(, 1).Value
か
Endプロパティで最終行を求めてでしょうか。


	【72676】Re:＜を含む言葉を抜き出す

kanabun - 12/9/2(日) 21:04 -


	引用なし

	パスワード

▼おにこさん： >「＜＞」を含む言葉がある場合、AH列に「＜＞」を含む言葉を移動させたいです。参考まで、別法です Sub Try3b() 　　Dim r As Range, c As Range 　　Dim ss As String, v, vv 　　Dim aa() As String 　　Dim k As Long 　　Const z = "、" 　　　　Set r = Range("AA1", Cells(Rows.Count, "AA").End(xlUp)) 　　For Each c In r 　　　　ss = c.Value 　　　　If ss Like "*＜*＞*" Then 'セル内に＜*＞があれば　　　　　　vv = Split(ss, z) '"、"でブロックに分割　　　　　　ReDim aa(1) 　　　　　　For Each v In vv 　　　　　　　　 'このブロックは＜*＞があるか　　　　　　　　k = IIf(v Like "*＜*＞*", 1, 0) 　　　　　　　　If Len(aa(k)) > 0 Then 　　　　　　　　　　aa(k) = aa(k) & z & v 　　　　　　　　Else 　　　　　　　　　　aa(k) = v 　　　　　　　　End If 　　　　　　Next 　　　　　　c.Value = aa(0)　　　　　 '＜*＞の含まれないブロック　　　　　　c.Offset(, 7).Value = aa(1) '＜*＞の含まれるブロック　　　　End If 　　Next End Sub


	【72677】Re:＜を含む言葉を抜き出す

おにこ - 12/9/3(月) 9:41 -


	引用なし

	パスワード

ドカさん

丁寧に回答していただきありがとうございます。
初心者なので、大変助かります。
ひとつずつ理解していきたいと思います。
本当にどうもありがとうございました。

▼ドカさん：
>>>▼おにこさん　
>また時間ができたので、やっておきました。
>
>私のマクロは、他の皆さんと違って、基本的なことさえ知っていれば、作れるコードで書いています。マクロの記録などもそのまま使っています。
>それでも動くことがVBAの最大のメリットではないのかな？
>ただし、処理速度が遅くて使いものにならない時は、別途スマートなコードが必要です。
>
>Sub Macro4()
>　　シート名 = ActiveSheet.Name
>　　ActiveSheet.Copy Before:=Sheets(1)
>
>　　シート名1 = ActiveSheet.Name
>　　Columns("A:Z").Select
>　　Selection.Delete Shift:=xlToLeft
>　　
>
>'データ分解()
>　　
>　　Columns("A:A").Select
>　　Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
>　　　　TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
>　　　　Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
>　　　　:="、", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
>
>
>' 探す()
>
>
>For n = 1 To 10
>p = 0
>p1 = 0
>　
>　　For i = 1 To 10
>　　　　If Cells(n, i) <> "" Then
>　　　　　　If Cells(n, i).Value Like "*＜*" Then
>　　　　　　　　Cells(n, 33 + p) = Cells(n, i)
>　　　　　　　　p = p + 1
>　　　　　　Else
>　　　　　　　　Cells(n, 27 + p1) = Cells(n, i)
>　　　　　　　　p1 = p1 + 1
>　　　　　　End If
>　　　　Else
>　　　　　　Exit For
>　　　　End If
>　　Next
>Next
>
>
>' 結合()
>For n = 1 To 10
>　　For i = 1 To 5
>　　　　If Cells(n, 27 + i) <> "" Then
>　　　　　　Cells(n, 27) = Cells(n, 27) & "、" & Cells(n, 27 + i)
>　　　　　　Cells(n, 27 + i) = ""
>　　　　End If
>　　Next
>Next
>
>For n = 1 To 10
>　　For i = 1 To 5
>　　　　If Cells(n, 33 + i) <> "" Then
>　　　　　　Cells(n, 33) = Cells(n, 33) & "、" & Cells(n, 33 + i)
>　　　　　　Cells(n, 33 + i) = ""
>　　　　End If
>　　Next
>Next
>
>' 貼り付け()
>'
>
>　　Columns("AA:AA").Select
>　　Selection.Copy
>
>　　Worksheets(シート名).Select
>
>　　Columns("AA:AA").Select
>　　ActiveSheet.Paste
>
>　　Worksheets(シート名1).Select
>　　Columns("AG:AG").Select
>　　Selection.Copy
>
>　　Worksheets(シート名).Select
>
>　　Columns("AG:AG").Select
>　　ActiveSheet.Paste
>
>　　Worksheets(シート名1).Delete
>End Sub


	【72678】Re:＜を含む言葉を抜き出す

おにこ - 12/9/3(月) 9:42 -


	引用なし

	パスワード

Yuki さん

丁寧に回答していただきありがとうございます。
初心者なので、大変助かります。
ひとつずつ理解していきたいと思います。
本当にどうもありがとうございました。

▼Yuki さん：
>▼kanabun さん：
>>
>>>こんな感じで
>>>　　v = Range("AA1").CurrentRegion.Resize(, 1).Value
>>
>>A列～ Z列までデータがあったばあいは、変数v にどの列の
>>値が入るのでしょうか？
>
>kanabunさん、どうもです。
>最近CurentResionの件で能書きを書いたそのまんまですね。
>えらい勘違いです。
>v = Range("AA1").CurrentRegion,offset(,26).Resize(, 1).Value
>か
>Endプロパティで最終行を求めてでしょうか。


	【72679】Re:＜を含む言葉を抜き出す

おにこ - 12/9/3(月) 9:44 -


	引用なし

	パスワード

▼kanabun さん：

わかりやすく、丁寧に説明していただきありがとうございます。
印刷して、じっくり読んで勉強しようと思います。
本当に感謝しています。ありがとうございました。

>▼おにこさん：
>
>>「＜＞」を含む言葉がある場合、AH列に「＜＞」を含む言葉を移動させたいです。
>
>参考まで、別法です
>
>Sub Try3b()
>　　Dim r As Range, c As Range
>　　Dim ss As String, v, vv
>　　Dim aa() As String
>　　Dim k As Long
>　　Const z = "、"
>　　
>　　Set r = Range("AA1", Cells(Rows.Count, "AA").End(xlUp))
>　　For Each c In r
>　　　　ss = c.Value
>　　　　If ss Like "*＜*＞*" Then 'セル内に＜*＞があれば
>　　　　　　vv = Split(ss, z) '"、"でブロックに分割
>　　　　　　ReDim aa(1)
>　　　　　　For Each v In vv
>　　　　　　　　 'このブロックは＜*＞があるか
>　　　　　　　　k = IIf(v Like "*＜*＞*", 1, 0)
>　　　　　　　　If Len(aa(k)) > 0 Then
>　　　　　　　　　　aa(k) = aa(k) & z & v
>　　　　　　　　Else
>　　　　　　　　　　aa(k) = v
>　　　　　　　　End If
>　　　　　　Next
>　　　　　　c.Value = aa(0)　　　　　 '＜*＞の含まれないブロック
>　　　　　　c.Offset(, 7).Value = aa(1) '＜*＞の含まれるブロック
>　　　　End If
>　　Next
>End Sub


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

1681 / 13646 ﾂﾘｰ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free