Excel VBA質問箱 IV

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

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

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
1994 / 13645 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【70580】初心者ですいません まさ 11/12/4(日) 11:12 質問[未読]
【70582】Re:初心者ですいません UO3 11/12/4(日) 13:13 発言[未読]
【70590】Re:初心者ですいません まさ 11/12/5(月) 11:56 質問[未読]
【70593】Re:初心者ですいません UO3 11/12/5(月) 13:30 発言[未読]
【70594】Re:初心者ですいません UO3 11/12/5(月) 14:22 回答[未読]
【70598】Re:初心者ですいません まさ 11/12/5(月) 19:27 質問[未読]
【70602】Re:初心者ですいません UO3 11/12/6(火) 6:30 発言[未読]
【70603】Re:初心者ですいません UO3 11/12/6(火) 6:39 発言[未読]
【70604】Re:初心者ですいません まさ 11/12/6(火) 9:12 発言[未読]
【70607】Re:初心者ですいません UO3 11/12/6(火) 11:16 回答[未読]
【70580】初心者ですいません
質問  まさ  - 11/12/4(日) 11:12 -
引用なし
パスワード
   　　Range("B3").Select
　　ActiveCell.FormulaR1C1 = "=IF(RC[11]="""","""",MID(RC[11],1,FIND("" "",RC[11],1)-1))"
　　Range("B4").Select
　　ActiveCell.FormulaR1C1 = "=IF(R[1]C[11]="""","""",R[1]C[11])"
　　Range("B5").Select
　　ActiveCell.FormulaR1C1 = "=IF(R[2]C[11]="""","""",MID(R[2]C[11],1,FIND("" "",R[2]C[11],1)-1))"
　　Range("B6").Select
　　ActiveCell.FormulaR1C1 = "=IF(R[3]C[11]="""","""",R[3]C[11])"
　　Range("B7").Select
　　ActiveCell.FormulaR1C1 = "=IF(R[4]C[11]="""","""",MID(R[4]C[11],1,FIND("" "",R[4]C[11],1)-1))"
　　Range("B8").Select
　　ActiveCell.FormulaR1C1 = "=IF(R[5]C[11]="""","""",R[5]C[11])"
　　Range("B9").Select
　　ActiveCell.FormulaR1C1 = "=IF(R[6]C[11]="""","""",MID(R[6]C[11],1,FIND("" "",R[6]C[11],1)-1))"
　　Range("B10").Select
　　ActiveCell.FormulaR1C1 = "=IF(R[7]C[11]="""","""",R[7]C[11])"
　　Range("B11").Select
　　ActiveCell.FormulaR1C1 = "=IF(R[6]C[11]="""","""",MID(R[8]C[11],1,FIND("" "",R[8]C[11],1)-1))"
　　Range("B12").Select
　　ActiveCell.FormulaR1C1 = "=IF(R[7]C[11]="""","""",R[9]C[11])"
　　Range("B13").Select
　　ActiveCell.FormulaR1C1 = "=IF(R[6]C[11]="""","""",MID(R[10]C[11],1,FIND("" "",R[10]C[11],1)-1))"
　　Range("B14").Select
　　ActiveCell.FormulaR1C1 = "=IF(R[7]C[11]="""","""",R[11]C[11])"


このようなデータがB1000くらいまでに続いています。

うまくまとめるにどうしたらいいでしょうか？


あと、もうひとつあるのですが


　 A　 B　 C　 D
1　　名前
2　　性別
3　　 歳
4　　性格
5　　名前
6　　性別
7　　 歳
8　　性格
　　　・
　　　・
　　　・
　　　・
のようなデータがこちらもB1000位まであるのですが、
名前と歳だけを別のシートに並べたいのですが、どうすればよいでしょうか？


どなたかご教授ください。

よろしくお願いいたします。
【70582】Re:初心者ですいません
発言  UO3  - 11/12/4(日) 13:13 -
引用なし
パスワード
   ▼まさ さん：

こんにちは

最初の計算式のセット、２行ペアの各ペアにセットすべき式のパターン、誤解しているかもしれませんが

Sub Test()
　　Dim i As Long
　　Dim form1 As String
　　Dim form2 As String
　　
　　form1 = "=IF(R[@]C[11]="""","""",MID(R[@]C[11],1,FIND("" "",R[@]C[11],1)-1))"
　　form2 = "=IF(R[@]C[11]="""","""",R[@]C[11])"
　　
　　For i = 3 To 999 Step 2
　　　　Range("B" & i).FormulaR1C1 = Replace(form1, "@", i - 3)
　　　　Range("B" & i + 1).FormulaR1C1 = Replace(form2, "@", i - 2)
　　Next
End Sub

データの抽出に関してはタイトル行をもうけた上で、オートフィルタで抽出したものを別シートにコピペ。
あるいはフィルターオプションで別シートに抽出といった方法が簡便化と。
もちろん、いずれもマクロで実行可能です。
（上記操作をマクロ記録すれば基礎的なコードが生成されます）
【70590】Re:初心者ですいません
質問  まさ  - 11/12/5(月) 11:56 -
引用なし
パスワード
   　　Dim i As Long
　　Dim form1 As String
　　Dim form2 As String
　　Dim lngLineM As Long
　　Dim lngLineN As Long
　　Dim lngLineO As Long
　　Dim lngLineP As Long
　　Dim lngLineQ As Long
　　Dim lngLineR As Long

　　　 lngLineM = Range("M3").End(xlDown).Row / 2
　　　 lngLineN = Range("N3").End(xlDown).Row / 2
　　　 lngLineO = Range("O3").End(xlDown).Row / 2
　　　 lngLineP = Range("P3").End(xlDown).Row / 2
　　　 lngLineQ = Range("Q3").End(xlDown).Row / 2
　　　 lngLineR = Range("R3").End(xlDown).Row / 2


　　form1 = "=IF(R[@]C[11]="""","""",MID(R[@]C[11],1,FIND("" "",R[@]C[11],1)-1))"
　　form2 = "=IF(R[@]C[11]="""","""",R[@]C[11])"
　
　　For i = 3 To lngLineM Step 2 'lngLine Step 2
　　　　Range("B" & i).FormulaR1C1 = Replace(form1, "@", i - 3)
　　　　Range("B" & i + 1).FormulaR1C1 = Replace(form2, "@", i - 2)
　　Next
　　For i = 3 To lngLineN Step 2
　　　　Range("C" & i).FormulaR1C1 = Replace(form1, "@", i - 3)
　　　　Range("C" & i + 1).FormulaR1C1 = Replace(form2, "@", i - 2)
　　Next
　　For i = 3 To lngLineO Step 2
　　　　Range("D" & i).FormulaR1C1 = Replace(form1, "@", i - 3)
　　　　Range("D" & i + 1).FormulaR1C1 = Replace(form2, "@", i - 2)
　　Next
　　For i = 3 To lngLineP Step 2
　　　　Range("E" & i).FormulaR1C1 = Replace(form1, "@", i - 3)
　　　　Range("E" & i + 1).FormulaR1C1 = Replace(form2, "@", i - 2)
　　Next
　　For i = 3 To lngLineQ Step 2
　　　　Range("F" & i).FormulaR1C1 = Replace(form1, "@", i - 3)
　　　　Range("F" & i + 1).FormulaR1C1 = Replace(form2, "@", i - 2)
　　Next
　　For i = 3 To lngLineR Step 2
　　　　Range("G" & i).FormulaR1C1 = Replace(form1, "@", i - 3)
　　　　Range("G" & i + 1).FormulaR1C1 = Replace(form2, "@", i - 2)
　　Next

参考？ほとんどそのまんまですが、なんとかできたみたいです。
ありがとうございました。


一回で質問すればよかったのですが

ActiveCell.FormulaR1C1 = "=IF(RC[11]="""","""",MID(RC[11],1,FIND("" "",RC[11],1)-1))"
　　Range("B4").Select
　　ActiveCell.FormulaR1C1 = "=IF(R[3]C[11]="""","""",MID(R[3]C[11],3,LEN(R[3]C[11])-2))"
　　Range("B5").Select
　　ActiveCell.FormulaR1C1 = "=IF(R[3]C[11]="""","""",MID(R[3]C[11],1,FIND("" "",R[3]C[11],1)-1))"
　　Range("B6").Select
　　ActiveCell.FormulaR1C1 = "=IF(R[6]C[11]="""","""",MID(R[6]C[11],3,LEN(R[6]C[11])-2))"
　　Range("B7").Select
　　ActiveCell.FormulaR1C1 = "=IF(R[6]C[11]="""","""",MID(R[6]C[11],1,FIND("" "",R[6]C[11],1)-1))"
　　Range("B8").Select
　　ActiveCell.FormulaR1C1 = "=IF(R[9]C[11]="""","""",MID(R[9]C[11],3,LEN(R[9]C[11])-2))"
　　Range("B9").Select

上記のようなデータもあるのですが、こちらはうまくいきません。
なんども申し訳ありませんがご教授のほど、よろしくお願いします。
【70593】Re:初心者ですいません
発言  UO3  - 11/12/5(月) 13:30 -
引用なし
パスワード
   ▼まさ さん：

最初にも、申し上げようかな？とも思ったんですけど
アップされた計算式を、こちらでチェックして、それぞれの計算領域はおそらく、こんなルールなんだろうなと
想像しなきゃいけませんよね。

そうではなく、こんな計算をしたい（こんな計算式をセットしたい）という、そのルールを
「言葉」で説明できませんか？

（アップされた式をみて、頭の体操で、考えてはみますけど・・・）
【70594】Re:初心者ですいません
回答  UO3  - 11/12/5(月) 14:22 -
引用なし
パスワード
   ▼まさ さん：

とりあえず「頭の体操」をして、式のルールを想像しました。
おそらくＭ列に３行目からはじまる５行単位のブロックがあって
それに対してＢ列の３行目からはじまる２行単位のペアを

B列の２つのペアの●組目の１行目　は　M列の５行１組の●組目のブロックの先頭行○　を相手にする。
B列の２つのペアの●組目の２行目　は　M列の５行１組の●組目のブロックの最終行□　を相手にする。

こんなことでしょうかね？

で、この場合、現在のＢ列の行からの「相対的」な行の位置より、直接、計算で求めて指定したほうが
わかりやすいと思います。

つまり、このペアは

"=IF(R○C[11]="""","""",MID(R○C[11],1,FIND("" "",R○C[11],1)-1))"
"=IF(R□C[11]="""","""",MID(R□C[11],3,LEN(R□C[11])-2))"

こんな式で、R[n] という相対指定ではなく Rn と　直接指定します。

● = (B列の行 - 3) / 2 の商 + 1 ですね。
そうすると
○ = (● - 1) * 5 + 3
□ = (● - 1) * 5 + 4 + 3
こうなります。（これは、ＶＢＡというより算数の問題ですね）

ですから、計算式の○と□をB列の行番号を元に計算した結果で置き換えてセットします。
そうしますと、以下でしょうかね？

Sub Test2()
　　Dim i As Long
　　Dim form1 As String
　　Dim form2 As String
　　Dim n As Long
　　form1 = "=IF(R○C[11]="""","""",MID(R○C[11],1,FIND("" "",R○C[11],1)-1))"
　　form2 = "=IF(R□C[11]="""","""",MID(R□C[11],3,LEN(R□C[11])-2))"
　
　　For i = 3 To 999 Step 2
　　　　n = (((i - 3) \ 2 + 1) - 1) * 5 + 3
　　　　Range("B" & i).FormulaR1C1 = Replace(form1, "○", n)
　　　　Range("B" & i + 1).FormulaR1C1 = Replace(form2, "□", n + 4)
　　Next
End Sub
【70598】Re:初心者ですいません
質問  まさ  - 11/12/5(月) 19:27 -
引用なし
パスワード
   ご指摘ありがとうございます。
細かく書くとこういう感じです。

　 A　　B　　　 　　　 C　 　・・・・　　　M　　　　　　　　　N　　　　　　O
3　　 名前1　　　　 名前A　　　　 "名前1_歳"　　　　"名前A_歳"
4　xx:xx〜xx:xx1 xx:xx〜xx:xxA　　　情報1　　　　　　 情報A
5　　 名前2　　　　 名前B　　　　　 特技1　　　　　　 特技A
6　xx:xx〜xx:xx2 xx:xx〜xx:xxB　　　性格1　　　　　　 性格A
7　　 名前3　　　　 名前C　　　"時間xx:xx〜xx:xx"1 "時間xx:xx〜xx:xx"A
8　xx:xx〜xx:xx3 xx:xx〜xx:xxC　　"名前2_歳"　　　　"名前B_歳"
9　　 名前4　　　　 名前D　　　　　 情報2　　　　　　 情報B
10 xx:xx〜xx:xx4 xx:xx〜xx:xxD　　　特技2　　　　　　 特技B
11　　名前5　　　　 名前E　　　　　 性格2　　　　　　 性格B
12 xx:xx〜xx:xx5 xx:xx〜xx:xxE "時間xx:xx〜xx:xx"2 "時間xx:xx〜xx:xx"B

ちなみにC列とO列も同様です。

M・N・O列はWebクエリでデータを貼り付けているのですが、問題があります。
特技が表示されていないときがありますので、そのときはデータが
　"名前y_歳"
　　情報y
　　性格y
"時間xx:xx〜xx:xx"y
　"名前z_歳"
　　情報z
　　特技z
　　性格z
"時間xx:xx〜xx:xx"z

という風に順番をみだします。

その際、"時間"をFINDして一行"データなし"というワードを入れて配列を保ちたいのですが、ご教授お願いいたします。
【70602】Re:初心者ですいません
発言  UO3  - 11/12/6(火) 6:30 -
引用なし
パスワード
   ▼まさ さん：

このレイアウトで考えてみます。
ところで、現在のコードは「式」をセットして、式で結果を表示していますけど、
式ではなく、結果がセットされてもいいですか？
【70603】Re:初心者ですいません
発言  UO3  - 11/12/6(火) 6:39 -
引用なし
パスワード
   ▼まさ さん：

>ちなみにC列とO列も同様です。

Ｍ列をＢ列に、Ｏ列をＣ列にということですね。
Ｎ列は無視でいいですね。

>M・N・O列はWebクエリでデータを貼り付けているのですが、問題があります。
>特技が表示されていないときがありますので、

特技がない場合ですけど、すべての列で、同じように「無い」のですか？
それとも、Ｍ列にはないけどＯ列にはあるというケースもあるのでしょうか？
【70604】Re:初心者ですいません
発言  まさ  - 11/12/6(火) 9:12 -
引用なし
パスワード
   >ところで、現在のコードは「式」をセットして、式で結果を表示していますけど、
>式ではなく、結果がセットされてもいいですか？

大丈夫です。

>Ｍ列をＢ列に、Ｏ列をＣ列にということですね。
>Ｎ列は無視でいいですね。

Ｎ列は無視でいいです

>特技がない場合ですけど、すべての列で、同じように「無い」のですか？

あったりなかったりします。

>それとも、Ｍ列にはないけどＯ列にはあるというケースもあるのでしょうか？

Ｍ列、Ｏ列ともあったりなかったりします。


現在は特技のない場合"特技なし"と手動で挿入して列の間隔を保つようにしています。

これをマクロで制御したいのです。


言葉が足りずに申し訳ございません。
【70607】Re:初心者ですいません
回答  UO3  - 11/12/6(火) 11:16 -
引用なし
パスワード
   ▼まさ さん：

以下、とりあえず。

>"時間"をFINDして一行"データなし"というワードを入れて

どこにいれるのかが不明でしたので、ここは以下のコードにはいれていません。

>"名前1_歳" -> 名前1 あるいは　"時間xx:xx〜xx:xx"1 -> xx:xx〜xx:xx1

かならず、このような文字列規則、" で囲まれているとか、 _ で区切られているとか　時間の数字が　" の右にある
ということを前提にしています。

また、抽出は、"名前 という文字列で始まるセルと "時間　という文字列で始まるセルを対象にします。
（つまり、この２つは、Ｍ列、Ｏ列の１組のブロック内に必ず存在するという前提）

Sub Test3()
　　Dim z1 As Long
　　Dim z2 As Long
　　Dim z As Long
　　Dim v() As String　'B,C列要配列
　　Dim i As Long
　　Dim j As Long
　　Dim x As Long
　　Dim y As Long
　　Dim d As String
　　Dim s As String
　　
　　Dim col As Variant
　　
　　z1 = Range("M" & Rows.Count).End(xlUp).Row 'M列最終行
　　z2 = Range("O" & Rows.Count).End(xlUp).Row 'O列最終行
　　z = WorksheetFunction.Max(z1, z2) 'いずれか大きい値
　　
　　ReDim v(1 To z, 1 To 2)
　　x = 1
　　For Each col In Array("M", "O")
　　　　y = 1
　　　　For i = 3 To z
　　　　　　s = Empty
　　　　　　d = Cells(i, col).Value
　　　　　　Select Case Mid(d, 2, 2)
　　　　　　　　Case "名前"
　　　　　　　　　　s = Split(Replace(d, """", ""), "_")(0)
　　　　　　　　Case "時間"
　　　　　　　　　　s = Mid(Replace(d, """", ""), 3)
　　　　　　End Select
　　　　　　If Len(s) > 0 Then
　　　　　　　　y = y + 1
　　　　　　　　v(y, x) = s
　　　　　　End If
　　　　Next
　　　　x = x + 1
　　Next
　　
　　Columns("B:C").ClearContents
　　Range("B3").Resize(z, 2).Value = v
　　
End Sub
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
1994 / 13645 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free