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