人に聞けない痔の悩み、これでスッキリ >>

Excel2003 vba
お世話になります。以下のようなコードを書いているのですが、意図しない動きをしているのでご教授願いたいです。

No|名前 |食べられる
1 |リンゴ|○
2 |テレビ|
3 |電話 |
4 |バナナ|○
5 |ミカン|○

上のようなデータにオートフィルタをかけて、○がついているデータだけを配列に取り込もうとしています。

Dim Buff As Variant
Cells(1, 1).AutoFilter field:=3, Criteria1:="○"
Range("A1").CurrentRegion.Select
Buff = Range("A2", "C6").SpecialCells(xlCellTypeVisible) '一番上はフィールド名なのでA2から

フィルタがかかった状態で見えている「リンゴ」「バナナ」「ミカン」のデータだけをBuffに取り込んでいるつもりなのですが、Buffの中には1行目にかかれている「リンゴ」のデータしか入ってきません。
フィルタがかかっている時は違うデータの取り方があるのでしょうか。
よろしくお願いします。

このQ&Aに関連する最新のQ&A

A 回答 (4件)

例データ


A列   B列  C列
1ax
2by
3cz
4at
5sy
6au
7gr
8st
ーー
コード  B列がaの、C列の値を配列に
Sub test01()
Dim d(100)
Dim Buff As Variant
Cells(1, 1).AutoFilter field:=2, Criteria1:="a"
Range("A1").CurrentRegion.Select
Set Buff = Range("A1:C8").SpecialCells(xlCellTypeVisible)
For Each cl In Buff
If cl.Column = 3 Then
d(k) = cl
k = k + 1
MsgBox cl
End If
Next
End Sub
ーー
表示されるもの
X,t,u
    • good
    • 1

こんばんは。



配列というのは、全部が繋がっているものか、マトリックス(格子)になっているものだけです。
普通は、一旦、セルに貼り付けしてから、再度取り直しますが、直接、取得するなら、以下のコードのようにします。

配列に取得したものを、出力する場合は、配列が、縦横が逆に取れていますから、取得した後に、Transpose 関数で、縦横を転換する必要があります。
'-------------------------------------------

Sub Test1()
  Dim Buff() As Variant
  Dim r As Range
  Dim c As Range
  Dim d As Range
  Dim i As Long
  Dim col As Long
  Dim k As Long
  With ActiveSheet
    .Cells(1, 1).AutoFilter field:=3, Criteria1:="○"
    With .AutoFilter.Range
      Set r = .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible)
      col = .Columns.Count
    End With
  End With
  For Each c In r.Rows
    ReDim Preserve Buff(col - 1, i)
    For Each d In c.Cells
      Buff(k, i) = d
      k = k + 1
    Next d
    k = 0
    i = i + 1
  Next c
'Range("A15").Resize(UBound(Buff, 2) + 1, col).Value = Application.Transpose(Buff)  
End Sub

'-------------------------------------------
    • good
    • 1

いやーはずしてました。


やったことはありませんがそれでいいと思っていました。
下のコードを実行してみたら
Sub Buddd()
Dim s As Variant
s = Union(Range("A1:B3"), Range("A10:B13"))
Debug.Print UBound(s, 1)
End Sub
結果は3
飛び飛びの範囲はvariantに代入すると最初の範囲しか入らないようです。
    • good
    • 0
この回答へのお礼

フィルタではなく、そういう問題があるんですね。
ちょっとアプローチを変えてみます。

できそうでできなかったので、むず痒くて^^;
ありがとうございます。

お礼日時:2009/12/09 18:04

>Buffに取り込んでいるつもりなのですが、Buffの中には1行目にかかれている「リンゴ」のデータしか入ってきません。


ちゃんと入ると思いますけど
Buffはどうやって見ています?
イミディエイトウインドで ?Buff(2,1) としてみてください。

この回答への補足

お世話になります。
イミディエイトウィンドウで入力してみたところ「インデックスが有効範囲にありません。」とメッセージが出ました。
ウォッチでも見ていたのですが、同様にBuff(2,x)以降のデータは取得できていません。

補足日時:2009/12/09 16:49
    • good
    • 0

このQ&Aに関連する人気のQ&A

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています

このQ&Aを見た人が検索しているワード

このQ&Aと関連する良く見られている質問

QエクセルVBAでフィルタ抽出部分のみのコピー

エクセルVBAで売上帳を作成していますが、オートフィルタでデータ抽出した後、表示されている行のみをコピーして別シートに貼りつけるにはどうすればよいのでしょう?

別シートは指定したセルに値のみの貼り付けをしたいと思っています。

宜しくお願いします。

Aベストアンサー

こんにちは
マクロの記録で作成した一例です。コメントを読んで、適当にアレンジして下さい。

Option Explicit
Sub SampleMacro1()
'
' SampleMacro1 Macro
' マクロ記録日 : 2009/3/13
'
 'フィルター部分
 Selection.AutoFilter Field:=1, Criteria1:="=ほげほげ", Operator:=xlAnd
 '可視セルの選択
 Selection.SpecialCells(xlCellTypeVisible).Select
 '選択範囲のコピー
 Selection.Copy
 'コピー先のシート&セル選択
 Sheets("Sheet2").Select
 Range("A1").Select
 'ペースト
 ActiveSheet.Paste
 'コピー元シートに戻りコピー状態解除
 Sheets("Sheet1").Select
 Application.CutCopyMode = False
 Range("A1").Select
End Sub

外してたら、ごめんなさい

こんにちは
マクロの記録で作成した一例です。コメントを読んで、適当にアレンジして下さい。

Option Explicit
Sub SampleMacro1()
'
' SampleMacro1 Macro
' マクロ記録日 : 2009/3/13
'
 'フィルター部分
 Selection.AutoFilter Field:=1, Criteria1:="=ほげほげ", Operator:=xlAnd
 '可視セルの選択
 Selection.SpecialCells(xlCellTypeVisible).Select
 '選択範囲のコピー
 Selection.Copy
 'コピー先のシート&セル選択
 Sheets("Sheet2").Select
 Range("A1").Select
 'ペース...続きを読む

QExcelマクロ:オートフィルタ3つ以上の条件

添付の画像を使って質問させて頂きます。
バージョンは2010です。

お客様名 A,B,C,D,E 以外のお客様名を抽出するようにマクロを組みたいのですが

ActiveSheet.Range("$A$1:$D$15").AutoFilter Field:=2, Criteria1:= _
"<"&">&"A", Operator:=xlOr, Criteria2:="<"&">&"B""

の様に考えましたが一つの列に3つ以上の条件では対応できないことが分かりました。

添付の画像は実際使用している表を簡素化しているため
お客様名が少ないですが、実際は多様なお客様名があります。

その中で特定した5社以外のお客様の情報を抽出したいです。

宜しくお願い致します。

Aベストアンサー

>特定した5社以外のお客様の情報を抽出したい

sub macro1()
 dim a
 a = application.transpose(range("B2:B" & range("B65536").end(xlup).row).value)

 a = filter(a, "A", false)
 a = filter(a, "B", false)
 a = filter(a, "C", false)
 a = filter(a, "D", false)
 a = filter(a, "E", false)

 range("A:D").autofilter field:=2, criteria1:=a, operator:=xlfiltervalues
end sub

とかでいいです。

QEXCEL VBA で現在開いているブックのファイル名を取得する方法

EXCEL2003 VBAで業務を簡素化するために、現在開いているブックのファイル名を取得する方法が分かりません。
作業手順をマクロを使って処理していますが、オリジナルのワークブックをファイル名を変えて保存し、以後、このワークブックを読み込んで使用しています。
このときのVBAは、オリジナルのファイル名を使っているため、ファイル名を変更するとエラーになり、以後の業務に使用できません。
常にファイル名を取得出来るVBAをどなたか、教えて下さい。

Aベストアンサー

>現在開いているブックのファイル名
 ちょっと曖昧な表現かなぁという気もいたしますが、VBAが書いてあるブックのブック名は
ThisWorkbook.Name
で、現在 "アクティブにして" 操作対象になっているブックの名前は
ActiveWorkbook.Name
ですね。

 しかし、
>VBAは、オリジナルのファイル名を使っているため、ファイル名を変更するとエラーになり
というような文脈からすると、
ThisWorkbook.Name
の方ですかね。

QExel VBA 別ブックから該当データを検索し、必要なデータを取得する方法について

部品表というブックがあります
A列に商品名、B列に商品番号が入力してあります。C列のコードは未入力です。
A列     B列     C列      
商品名  商品番号  コード
モータ  U-1325-L  
ホルダ  R-134256

また、コード一覧表という別のブックには、A列に商品番号と、B列にコードが、何千件も入力されています。

やりたいことは
部品表のC列のコード欄に、コード一覧表ブックから商品番号と一致するコードを貼り付けしたいのです。

部品表は、何百種類もありますので、関数ではなく、マクロで処理を希望します。

自分では、部品表の商品番号をコピーして、コード一覧表で検索し、検索結果の右隣のセル(B列のコード)の値を部品表のC列に貼り付ければよいかと思い、書いてみたんですが…

Sub 別ブックから貼り付ける()
  Dim 検索する As Long
Windows("部品表.xls").Activate
検索する = cells(i,2).Value
Windows("コード一覧表.xls").Activate
ActiveWindow.SmallScroll Down:=-3
Selection.AutoFilter Field:=3, Criteria1:="=検索する", Operator:= xlAnd

と、してみたものの、検索しても、その検索結果の隣のセルのコードをどうやって取得すればいいのかが、わかりませんでした。

基本事項は本で学びましたが、呪文のようなコードはよく理解できません。懸命にネットで検索して、訳して理解する努力をしてはいますが。

どうぞよろしくお願いします。

部品表というブックがあります
A列に商品名、B列に商品番号が入力してあります。C列のコードは未入力です。
A列     B列     C列      
商品名  商品番号  コード
モータ  U-1325-L  
ホルダ  R-134256

また、コード一覧表という別のブックには、A列に商品番号と、B列にコードが、何千件も入力されています。

やりたいことは
部品表のC列のコード欄に、コード一覧表ブックから商品番号と一致するコードを貼り付けしたいのです。

部品表は、何百種類もありますので、関数...続きを読む

Aベストアンサー

こんにちは。
とりあえず実用性も踏まえました。
メインの動作はワークシート関数のVLOOKUPをVBA上で使用していますので理解はしやすいかと思います。
また、質問文から察するに「部品表.xls」と「コード一覧表.xls」の両方を開いて処理されていますが「コード一覧表.xls」はプログラム内で開いて閉じているので実行するときは「コード一覧表.xls」は閉じて置いてください。
Option Explicit
Sub Sample()
 Application.ScreenUpdating = False
 Dim I As Long
 Dim xlBook
 Set xlBook = Workbooks.Open("C:\★★\コード一覧表.xls") '★要変更★
 I = 2
 Do While Range("A" & I).Value <> ""
  ThisWorkbook.Worksheets("Sheet1").Range("C" & I).Value = Application.VLookup(ThisWorkbook.Worksheets("Sheet1").Range("B" & I).Value, xlBook.Worksheets("Sheet1").Range("A2:B65535"), 2, 0)
  I = I + 1
 Loop
 xlBook.Close
 Application.ScreenUpdating = True
 MsgBox ("完了")
End Sub

こんにちは。
とりあえず実用性も踏まえました。
メインの動作はワークシート関数のVLOOKUPをVBA上で使用していますので理解はしやすいかと思います。
また、質問文から察するに「部品表.xls」と「コード一覧表.xls」の両方を開いて処理されていますが「コード一覧表.xls」はプログラム内で開いて閉じているので実行するときは「コード一覧表.xls」は閉じて置いてください。
Option Explicit
Sub Sample()
 Application.ScreenUpdating = False
 Dim I As Long
 Dim xlBook
 Set xlBook = Workbooks....続きを読む

QExcelで可視セルの行番号取得

Excelでグラフ(散布図)のポイントをクリックしたときに、そのグラフ上の何番目かを所得してレコード情報をフォーム上に表示するように作成しました。
しかし、オートフィルタで絞り込んだ場合には取得した番号と行番号が一致しないので困っています。
そこで質問なのですが
1.可視セルの何番目というような取得方法はあるのでしょうか?
2.それともグラフからポイントの何番目というのではなく、元データの行番号は取得可能でしょうか?

分かりにくい質問で申し訳ないのですが、よろしくお願いします。

Aベストアンサー

こんにちは。
元のコードがなくては、よく分かりませんが、こういうことでしょうか?

'サンプルコード
'可視セルを順番に取得しているはずです。

Sub test1()
 Dim myRows As String, c As Range
 Dim Rng As Range
 On Error GoTo 0
 '1番上をフィールド名(項目行)だとしたら
 Set Rng = Range("A2", Range("A2").End(xlDown)).SpecialCells(xlCellTypeVisible)
 On Error Resume Next
 For Each c In Rng.Cells
  myRows = myRows & "," & c.Row
 Next
 MsgBox Mid$(myRows, 2)
End Sub

QEXCEL VBAで計算値を四捨五入、切り上げ、切捨てする方法

ネットで探してみたのですが、計算結果を四捨五入して特定のセルを
返すにはどうしたらいいのでしょうか?

Sub hokangosa()

Dim ZPS As Double
Dim ZPOS As Double
Dim DMN As Double
MsgBox (" >>> 補間誤差自動計算 <<< ")
MsgBox (" >>> 初期値入力します <<< ")
ZPS = InputBox(">>> ステップを入力してください<<<")
ZPOS = Sheet1.Cells(22, 4).Value
DMN = ZPOS / ZPS
Sheet1.Cells(23, 6).Value = DMN
End Sub

ここでDMNの値を四捨五入したいです。

またこれとは別に切上げ、切捨ても教えていただけるとありがたいです。

Aベストアンサー

DMN = Application.WorksheetFunction.Round(ZPOS / ZPS, 0)
で、四捨五入
DMN = Application.RoundDown(ZPOS / ZPS, 0)
で切り捨て
DMN = Application.RoundUp(ZPOS / ZPS, 0)
で切り上げです。

引数で、対象桁を変更できます。

QExcelVBAでデータを一括してセルに貼り付ける

こんばんは

ExcelVBAで教えてください。
配列のデータをセルに貼り付ける方法です。
一つ一つ行う方法は解ります。
しかし、これでは件数が多いと時間がかかってしまいます。
まとめて貼り付ける方法を教えてください。
例えば次のように100列1000行のデータのとき、一つ一つでは10万回も貼り付けることになります。
これを1行単位で1000回とか全部まとめて1回とかでできないでしょうか。
配列データを用意する都合で1行単位もお願いします。


For Row = 1 To 1000
For Column = 1 To 100
Cells(Row, Column).Value = 配列(Row - 1, Column - 1)
Next
Next

Aベストアンサー

http://www.asahi-net.or.jp/~ef2o-inue/vba_k/sub04_070_08.html
を参考にしてください。

QEXCELのVBA-フィルタ抽出後のセル選択方法

EXCELのVBAです。
 オートフィルタ(Autofilter)で、何らかの条件で抽出をかけた後の部分で、
特定のセル、例えば、2列目の上から5番目のセル、を選択するには、
どうすれば良いでしょう?

 言い方を変えれば、可視セルの中だけで、何列目で何行目セルという指定
をするにはどうすれば良いかと。

 RangeとかSelectionで、指定する方法が有るのでしょうか?

よろしくお願いいたします。

Aベストアンサー

回答1~3をした者です。
私が訂正したところが直っていれば正しく走ると思うのですが。
(win7pro32bit, xl2003で確認)

Sub test()
Dim c As Range
Dim i As Integer
For Each c In ActiveSheet.Columns(2).SpecialCells(xlCellTypeVisible)
i = i + 1
If i = 6 Then  '←1行目はヘッダー行なので
c.Select
Exit Sub
End If
Next
End Sub

Qオートフィルターで指定した値を取得したい

表題の通りです。

オートフィルターで指定した値を、別のセルに表示させたいのですが
そのようなことは可能でしょうか?

Aベストアンサー

標題の「オートフィルターで指定した値」とは、「オートフィルタによる絞り込みの条件とした値」という意味でよろしいでしょうか?


A 列に数値データがあり、それを 1 種類の値のみに絞り込むという場合、次式によりその値を取得できます。この数式は、平均値を求めています。したがって A 列に複数の種類の値が表示されている状態では、小数などを返します。

=subtotal(1,a:a)


文字列などの数値でない値であっても取得するには、マクロを使います。オートフィルタがあるシートのシートタブを右クリック、「コードの表示」から表示されるコードウィンドウに次のコードを貼り付け。

絞り込んだ瞬間ではなく、その次にカーソルを動かした瞬間に、E1 セルに絞り込み条件となっている値を記入します。


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  With Me
    If .AutoFilterMode Then
      With .AutoFilter.Filters(1)
        If .On Then Range("e1").Value = Replace(.Criteria1, "=", "")
      End With
    End If
  End With
End Sub

標題の「オートフィルターで指定した値」とは、「オートフィルタによる絞り込みの条件とした値」という意味でよろしいでしょうか?


A 列に数値データがあり、それを 1 種類の値のみに絞り込むという場合、次式によりその値を取得できます。この数式は、平均値を求めています。したがって A 列に複数の種類の値が表示されている状態では、小数などを返します。

=subtotal(1,a:a)


文字列などの数値でない値であっても取得するには、マクロを使います。オートフィルタがあるシートのシートタブを右クリック、「...続きを読む

QEXCELファイルのカレントフォルダを取得するには?

EXCELファイルのカレントフォルダを取得するには?

C:\経理\予算.xls

D:\2005年度\予算.xls

EXCEL97ファイルがあります。

VBAで
  カレントフォルダ名
(C:\経理\,D:\2005年度\)
を取得する事は可能でしょうか?

CURDIRでは上手い方法が見つかりませんでした。

Aベストアンサー

こんばんは。
Excel97 でも、同じですね。以下で試してみてください。

Sub test()
'このブックのパス
a = ThisWorkbook.Path
'アクティブブックのパス
b = ActiveWorkbook.Path
'Excelで設定されたデフォルトパス
c = Application.DefaultFilePath
'カレントディレクトリ
d = CurDir
MsgBox "このブックのパス   : " & a & Chr(13) & _
   "アクティブブックのパス: " & b & Chr(13) & _
   "デフォルトパス    : " & c & Chr(13) & _
   "カレントディレクトリ : " & d & Chr(13)
End Sub


このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング