Excel VBA質問箱 IV

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

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

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
7781 / 13644 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【36876】コードの解説 はじめ 06/4/17(月) 11:23 質問[未読]
【36880】Re:コードの解説 Statis 06/4/17(月) 11:52 回答[未読]
【36887】Re:コードの解説 はじめ 06/4/17(月) 14:25 発言[未読]
【36888】Re:コードの解説 Statis 06/4/17(月) 14:43 発言[未読]
【36889】Re:コードの解説 はじめ 06/4/17(月) 15:12 質問[未読]
【36890】Re:コードの解説 Statis 06/4/17(月) 15:21 回答[未読]
【36895】Re:コードの解説 はじめ 06/4/17(月) 17:18 お礼[未読]
【36891】Re:コードの解説 Kein 06/4/17(月) 15:25 回答[未読]
【36896】Re:コードの解説 はじめ 06/4/17(月) 17:27 質問[未読]
【36899】Re:コードの解説 Kein 06/4/17(月) 18:18 発言[未読]
【36900】Re:コードの解説 はじめ 06/4/17(月) 18:56 発言[未読]
【36902】Re:コードの解説 Kein 06/4/17(月) 20:27 回答[未読]
【36920】Re:コードの解説 はじめ 06/4/18(火) 11:06 お礼[未読]
【36876】コードの解説
質問  はじめ  - 06/4/17(月) 11:23 -
引用なし
パスワード
   Sub kouji()
　　Dim rng As Range
　　Dim ans As Range
　　Dim crng As Range
　　Dim ccnt As Long
　　Dim idx As Long
　　On Error Resume Next
　　Set rng = Range("aa1", Cells(Rows.Count, 27).End(xlUp))
　　If rng.Count > 1 Then
　　　 With rng
　　　　　Set ans = .SpecialCells(xlCellTypeConstants)
　　　　　If Err.Number = 0 Then
　　　　　　 ReDim myarray(1 To ans.Count)
　　　　　　 ccnt = 0
　　　　　　 For Each crng In ans
　　　　　　　 myarray(ccnt + 1) = Asc(crng.Value)
　　　　　　　 ccnt = ccnt + 1
　　　　　　　 Next
　　　　　　 ReDim larray(1 To ccnt)
　　　　　　 For idx = 1 To ccnt
　　　　　　　　larray(idx) = Application.Small(myarray(), idx)
　　　　　　　　larray(idx) = Chr(larray(idx))
　　　　　　　　Next
　　　　　　 Range("e1").Value = Join(larray(), "+")
　　　　　　 End If
　　　　　End With
　　Else
　　　 Range("e1").Value = rng.Value
　　　 End If
End Sub

上記コードのマクロを使用していますが、
範囲を変えて同じマクロを使いたいのですが、
コードの意味がよくわからず、アレンジに苦しんでいます。
どなたか上記コードの解説をして頂けたらと思います。
どうぞよろしくお願い致します。
【36880】Re:コードの解説
回答  Statis  - 06/4/17(月) 11:52 -
引用なし
パスワード
   こんにちは

各関数は「ヘルプ」を参照して下さい。詳しく出ています。

範囲は下記です

>Set rng = Range("aa1", Cells(Rows.Count, 27).End(xlUp))
AA列を示しています。
仮にB列なら下記になります
Set rng = Range("B1", Cells(Rows.Count, 2).End(xlUp))
【36887】Re:コードの解説
発言  はじめ  - 06/4/17(月) 14:25 -
引用なし
パスワード
   ▼Statis さん：

お返事ありがとうございます。
投稿前にさんざんヘルプ見たのですが・・
良くわからなかったので質問させて頂きました。

どうもすみませんでした。
ありがとうございました。
【36888】Re:コードの解説
発言  Statis  - 06/4/17(月) 14:43 -
引用なし
パスワード
   こんにちは
簡単ですがこんな感じだと思います。

セルAA1からAA列の最終データを取得し更に値の入っている
セルだけを取得しその各セルの先頭の文字を文字コードで取得し（Asc関数）
更に、Small関数で文字コードの小さい順に抜き出しChr関数で再度文字に変換し
Join関数で結合（＋にて）させてセルE1に表示させていと思います

取得する範囲はコードではAA列ですこれをどこに変更したいのでしょうか？
【36889】Re:コードの解説
質問  はじめ  - 06/4/17(月) 15:12 -
引用なし
パスワード
   ▼Statis さん：
さっそくありがとうございます！！

実は『アイテム』というSheetのAB列の値をひとつずつ『+』でつないで
『集計』というSheetのrange("F4")へ飛ばしたいのです。

別Sheetへ反映させるというところで良くわからなくなってしまって
内容を一行ずつ確認したかったのです。

このような説明でわかりますでしょうか・・？
【36890】Re:コードの解説
回答  Statis  - 06/4/17(月) 15:21 -
引用なし
パスワード
   こんにちは

これで如何かな？
Sub kouji_1()
　　Dim rng As Range
　　Dim ans As Range
　　Dim crng As Range
　　Dim ccnt As Long
　　Dim idx As Long
　　
　　On Error Resume Next
　　With Worksheets("アイテム")
　　　　 Set rng = .Range("AB1", .Cells(Rows.Count, 28).End(xlUp))
　　End With
　　If rng.Count > 1 Then
　　　 With rng
　　　　　　Set ans = .SpecialCells(xlCellTypeConstants)
　　　　　　If Err.Number = 0 Then
　　　　　　　 ReDim myarray(1 To ans.Count)
　　　　　　　 ccnt = 0
　　　　　　　 For Each crng In ans
　　　　　　　　　 myarray(ccnt + 1) = Asc(crng.Value)
　　　　　　　　　 ccnt = ccnt + 1
　　　　　　　 Next
　　　　　　　 ReDim larray(1 To ccnt)
　　　　　　　 For idx = 1 To ccnt
　　　　　　　　　 larray(idx) = Application.Small(myarray(), idx)
　　　　　　　　　 larray(idx) = Chr(larray(idx))
　　　　　　　 Next
　　　　　　　 Worksheets("集計").Range("F4").Value = Join(larray(), "+")
　　　　　　End If
　　　 End With
　　Else
　　　 Worksheets("集計").Range("F4").Value = rng.Value
　　End If
　　On Error GoTo 0
End Sub
【36891】Re:コードの解説
回答  Kein  - 06/4/17(月) 15:25 -
引用なし
パスワード
   >『アイテム』というSheetのAB列の値をひとつずつ『+』でつないで
>『集計』というSheetのrange("F4")へ飛ばしたいのです

Sub Test()
　 Dim C As Range
　 Dim St As String

　 With Sheets("アイテム")
　　　If WorksheetFunction _
　　　.CountA(.Range("AB:AB")) = 0 Then Exit Sub
　　　For Each C In .Range("AB:AB").SpecialCells(2)
　　　　 St = St & C.Value & "+"
　　　Next
　 End With
　 St = Left$(St, Len(St) - 1)
　 Sheets("集計").Range("F4").Value = St
End Sub

で、どうかな ?
　
【36895】Re:コードの解説
お礼  はじめ  - 06/4/17(月) 17:18 -
引用なし
パスワード
   ▼Statis さん：

できました。
本当にありがとうございました。
【36896】Re:コードの解説
質問  はじめ  - 06/4/17(月) 17:27 -
引用なし
パスワード
   ▼Kein さん：
どうもありがとうございます。
今まで使っていたコードと全然違いますが、
同じ結果が得られました。完璧でした。

しかもコードが短い。
もし良ければ解説していただけたら
とてもうれしいです。
【36899】Re:コードの解説
発言  Kein  - 06/4/17(月) 18:18 -
引用なし
パスワード
   Sub Test()
　 Dim C As Range
　 Dim St As String

　 With Sheets("アイテム")
　 'アイテム・シートについて以下に記す

　　　If WorksheetFunction _
　　　.CountA(.Range("AB:AB")) = 0 Then Exit Sub
　　　'AB列に値が入力されていなければ、マクロは中止
　　　'これを判定しておかないと、次の SpecialCells がエラーになる

　　　For Each C In .Range("AB:AB").SpecialCells(2)
　　　'AB列で値が入力されているセルをループ

　　　　 St = St & C.Value & "+"
　　　　'文字列型変数に値を取り込み、"+" を追加

　　　Next
　　　'次のセルへ
　
　 End With
　 St = Left$(St, Len(St) - 1)
　'全ての値を連結したあと、一番最後の文字が"+"になっているので
　'その一文字のみを除く

　 Sheets("集計").Range("F4").Value = St
　 '集計シートの F4 に変数の値を入力

End Sub

というコードです。St = St & C.Value & "+" という文字列の連結は、
ごく一般的なやり方です。むしろ配列を作ってJoin関数で繋げる方が、
特殊なやり方と言えるかも知れません。
【36900】Re:コードの解説
発言  はじめ  - 06/4/17(月) 18:56 -
引用なし
パスワード
   ▼Kein さん：
keinさま
とてもわかりやすい説明ありがとうございました。
教えて頂いたコードを実行したのはダミーのデータでやったのですが、
実際のデータで行う際、AB列の終端データからRange("AB132")までの範囲で
取得することになります。
Range("AB1:AB100")にもデータが入っていて、これは取得されないようにしなければ
なりません。（説明不足でした。申し訳ありません）


>Sub Test()
>　 Dim C As Range
>　 Dim St As String
>
>　 With Sheets("アイテム")
>　
>　　　If WorksheetFunction _
>　　　.CountA(.Range("AB132,Range("AB65536".End(xlup)) = 0 Then Exit Sub
>　　
>　　　For Each C In .Range("AB:AB").SpecialCells(2)
>　　
>　　　　 St = St & C.Value & "+"
>　　　
>　　　Next
>　　
>　 End With
>　 St = Left$(St, Len(St) - 1)
>
>　 Sheets("集計").Range("F4").Value = St
>End Sub
>
これで大丈夫でしょうか？
【36902】Re:コードの解説
回答  Kein  - 06/4/17(月) 20:27 -
引用なし
パスワード
   Sub Test()
　 Dim MyR As Range, C As Range
　 Dim St As String

　 With Sheets("アイテム")
　　　Set MyR = .Range("AB132", .Range("AB65536").End(xlUp))
　 End With
　 If WorksheetFunction.CountA(MyR) = 0 Then
　　　Set MyR = Nothing: Exit Sub
　 End If
　 For Each C In MyR.SpecialCells(2)
　　　St = St & C.Value & "+"
　 Next
　 St = Left$(St, Len(St) - 1)
　 Sheets("集計").Range("F4").Value = St
　 Set MyR = Nothing
End Sub

というコードになります。
【36920】Re:コードの解説
お礼  はじめ  - 06/4/18(火) 11:06 -
引用なし
パスワード
   keinさま

本当にどうもありがとうございました。
大変勉強になりました。
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
7781 / 13644 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free