Excel VBA質問箱 IV

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

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


7538 / 13644 ツリー ←次へ | 前へ→

【38362】選択された複数の離れたセルの行位置を取得 akata 06/5/31(水) 22:10 質問[未読]
【38363】Re:選択された複数の離れたセルの行位置を... ぱっせんじゃー 06/5/31(水) 22:15 発言[未読]
【38365】Re:選択された複数の離れたセルの行位置を... ぱっせんじゃー 06/5/31(水) 22:20 発言[未読]
【38374】Re:選択された複数の離れたセルの行位置を... ichinose 06/6/1(木) 9:34 発言[未読]
【38368】Re:選択された複数の離れたセルの行位置を... Kein 06/5/31(水) 22:51 回答[未読]
【38401】Re:選択された複数の離れたセルの行位置を... akata 06/6/1(木) 23:03 発言[未読]
【38406】Re:選択された複数の離れたセルの行位置を... ichinose 06/6/2(金) 8:00 発言[未読]
【38416】Re:選択された複数の離れたセルの行位置を... Kein 06/6/2(金) 11:03 回答[未読]
【38459】Re:選択された複数の離れたセルの行位置を... akata 06/6/3(土) 13:45 お礼[未読]

【38362】選択された複数の離れたセルの行位置を取...
質問  akata  - 06/5/31(水) 22:10 -

引用なし
パスワード
   初めまして。
ここ最近からVBAを勉強してるものです。
標記の件で皆さんの力をお借りしたいと思いますので
助言下さい。

Ctrlを押しながらセルを選択すると
複数のセルを選択することができますが
この方法で選択された、互いに離れたセルの
行、列位置を取得する方法はないものでしょうか?

使用例
用意されたリスト内で抜き取りたい行をマウスにて複数選択。
マクロ実行により、選択された複数の行位置を取得し
選択された行データを別のシート等に一括コピー  等

上記質問内容にご不明な点があれば
連絡下さい。
何卒宜しくお願いします。

【38363】Re:選択された複数の離れたセルの行位置...
発言  ぱっせんじゃー  - 06/5/31(水) 22:15 -

引用なし
パスワード
   怒られてしまいそうなコードですが・・・。
こんなことをしたいのでしょうか?

Sub test()
Selection.EntireRow.Copy
Worksheets(2).Activate
ActiveSheet.Paste
Application.CutCopyMode = False
End Sub

【38365】Re:選択された複数の離れたセルの行位置...
発言  ぱっせんじゃー  - 06/5/31(水) 22:20 -

引用なし
パスワード
   配列を使用した方法です。

Sub test()
  Dim c As Range
  Dim MyRng As Range
  Dim i As Long
  Dim MyArray() As Variant
  If TypeName(Selection) <> "Range" Then Exit Sub
  Set MyRng = Selection
  i = -1
   For Each c In MyRng
     i = i + 1
        ReDim Preserve MyArray(0 To i)
     MyArray(i) = c.Address(0, 0)
   Next
  Range(Join(MyArray, ",")).EntireRow.Copy Worksheets(2).Cells(1, 1)
  Erase MyArray
End Sub

【38368】Re:選択された複数の離れたセルの行位置...
回答  Kein  - 06/5/31(水) 22:51 -

引用なし
パスワード
   Ctrlキー押しながら複数のセルを選択した後、右クリックで
各セルの値を、Sheet2のその位置に転記する。というマクロが
簡単で便利かと思います。該当シートのシートモジュールに

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, _
Cancel As Boolean)
  Dim C As Range
  Dim Ad As String

  If TypeName(Selection) <> "Range" Then Exit Sub
  Cancel = True
  For Each C In Selection
   If Not IsEmpty(C.Value) Then
     Ad = C.Address
     Sheets("Sheet2").Range(Ad).Value = C.Value
   End If
  Next
End Sub

【38374】Re:選択された複数の離れたセルの行位置...
発言  ichinose  - 06/6/1(木) 9:34 -

引用なし
パスワード
   ▼ぱっせんじゃー さん:
おはようございます。

ちょっと気になったので・・・。

この方法は、

Join(MyArray, ","))

↑のセルアドレスの文字列が255文字を超えるとエラーになります。
(Excel2000、2002では確認しています)
2003ではどうでしょうか?(どなたか確認して見てください)。


>配列を使用した方法です。
>
>Sub test()
>  Dim c As Range
>  Dim MyRng As Range
>  Dim i As Long
>  Dim MyArray() As Variant
>  If TypeName(Selection) <> "Range" Then Exit Sub
>  Set MyRng = Selection
>  i = -1
>   For Each c In MyRng
>     i = i + 1
>        ReDim Preserve MyArray(0 To i)
>     MyArray(i) = c.Address(0, 0)
>   Next
>  Range(Join(MyArray, ",")).EntireRow.Copy Worksheets(2).Cells(1, 1)
>  Erase MyArray
>End Sub

よって、この方法を使うなら、255文字というリミットを意識したコードに
しなくてはなりませんね!!

以前、ここで検証したものです

http://www.vbalab.net/vbaqa/c-board.cgi?cmd=ntr;tree=16518;id=excel

【38401】Re:選択された複数の離れたセルの行位置...
発言  akata  - 06/6/1(木) 23:03 -

引用なし
パスワード
   ぱっせんじゃーさん、ichinoseさん、Keinさん
早速のご返答、どうもありがとうございます。
ただ、私自身の力不足で教示されたコードの意味を完全に把握できないでいます。
教えて頂いたコードを流用することで、選択された複数の行位置を変数として
取得できるか、現在調べております。

また、参考として示した簡単な例があまりよくなかったようです。

現在作成しようとしているマクロの詳細を下記のとおり説明します。
あらかじめ作成されたリスト(見出し項目複数あり)から
抜き取りたい行をマウスにて複数選択。
必要項目のみテキスト化して抜き出す、といったものです。

リスト例)
日付    品名    メーカ    数量    価格    納入先    (見出し行)
5/30    a    ....
5/31    b    ....
5/31    c    ....

素人なりにプログラムのフローを下記のように考えています。
0、(マクロ実行前処理)抜き取りたい行をマウスにて選択
1、見出し行検索+抜き取り見出し列位置取得
    (抜き取り見出し項目は固定;日付、品名、数量、納入先)
2、選択された複数の行位置取得
3、動的配列展開
4、各データを配列に収納
5、notepadを開く
6、データの文字数を比較しtabで列を揃えながらデータをテキスト化

上記工程の中でどうしても分からないのが
工程2でして、この件で皆さんのお力を借りたいと考えていました。

まずは皆さんの教えて頂いたコードを解読し、勉強させて頂きます。

【38406】Re:選択された複数の離れたセルの行位置...
発言  ichinose  - 06/6/2(金) 8:00 -

引用なし
パスワード
   ▼akata さん:
おはようございます。

>2、選択された複数の行位置取得

選択した行を一行毎に処理するなら


標準モジュールに
'==================================================================
Sub test()
  Dim rng As Range
  Dim crng As Range
  Dim rw As Range
  If TypeName(Selection) = "Range" Then
    Set rng = Selection.EntireRow
    For Each crng In Union(rng, rng).Areas
     For Each rw In crng.Rows
       MsgBox rw.Address
       Next
     Next
    Union(rng, rng).Select
    End If

End Sub

として、セル範囲(行)を複数選択してから、testを実行してみてください

【38416】Re:選択された複数の離れたセルの行位置...
回答  Kein  - 06/6/2(金) 11:03 -

引用なし
パスワード
   先にレスした右クリックイベントを応用すると、以下のようになります。
選択するセルは、必ず A列 にして下さい。

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, _
Cancel As Boolean)
  Dim C As Range
  Dim i As Long
  Dim Buf As String
  Const MyF As String = _
  "C:\Documents and Settings\User\My Documents\Test.txt"
  '↑実際のテキストファイルの保存先とファイル名にすること

  If Intersect(Target, Range("A:A")) Is Nothing Then Exit Sub
  Cancel = True
  If Dir(MyF) <> "" Then Kill MyF
  Open MyF For OutPut Access Write As #1
  For Each C In Target
   i = C.Row
   If i > 1 And i <= Range("A65536").End(xlUp).Row Then
     Buf = Cells(i, 1).Value & vbTab & Cells(i, 2).Value & _
    vbTab & Cells(i, 4).Value & vbTab & Cells(i, 6).Value
    Print #1, Buf
   End If
  Next
  Close #1
  If Buf = "" Then
   MsgBox "テキストファイルは作成されませんでした", 48
   Kill MyF
  Else
   MsgBox "テキストファイルを作成しました", 64
  End If
End Sub

【38459】Re:選択された複数の離れたセルの行位置...
お礼  akata  - 06/6/3(土) 13:45 -

引用なし
パスワード
   ichinoseさん、Keinさん
プログラムを教えて頂き、どうもありがとうございます。

指示通りのマクロを実行することにより
私の希望通りの動きを確認することができました。
後はこのマクロを解読し、皆さんに少しでも近づけるよう
頑張りたいと思います。

この度は本当にありがとうございました。

7538 / 13644 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free