エクセル2007をつかっています。「会社で何月何日に、誰がどこへいったのか」がわかる表を作ろうとしていますが、
うまくつくれません。

シート1に以下のようなデータをつくり、

4月1日 佐藤 Aに訪問
4月2日 鈴木 Bに訪問
4月2日 加藤 Cに訪問

シート2のA1に「4月2日」と入力したら、このデータを参照して、A2とB2、A3とB3の
セルに、

4月2日
鈴木 Bに訪問
加藤 Cに訪問

と出力されるようにしたいのです。
INDIRECT、SMALL、ROWの機能をつかったり、いろいろ試してみたのですが、自分が素人なため、どうしてもうまくいきません。
どなたか詳しい方がいれば教えてください。よろしくお願いします

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

A 回答 (12件中1~10件)

いろんな考え方があって面白いですね。


私も勉強になりました、ありがとうございます。

蛇足みたいなものですが
Option Explicit

Sub sample0() 'サンプルブック作成コード。
  Dim ws  As Worksheet
  Dim fName As String

  fName = Application.DefaultFilePath & "\TMP20100416.xls"
  'DefaultFilePathにTMP20100416.xlsという名前のBookを作成します。
  With Workbooks.Add(xlWBATWorksheet)
    With .Sheets(1).Range("A1:C4")
      .Rows(1).Value = [{"日付","担当者","訪問先"}]
      .Rows(2).Value = [{"4月1日","佐藤","A"}]
      .Rows(3).Value = [{"4月2日","鈴木","B"}]
      .Rows(4).Value = [{"4月2日","加藤","C"}]
    End With
    
    'AdvancedFilter例は取り敢えず手動。
    'A2セル値を入力後 Sub sample1() 実行。
    With Sheets.Add
      .Name = "AdvancedFilter例"
      .Range("A1:A2").Value = [{"日付";"4月2日"}]
      .Range("A3:B3").Value = [{"担当者","訪問先"}]
    End With
    .SaveAs fName
    
    'パラメータクエリ例。
    'A1セル変更時更新。基本的には手作業で設定できるのでマクロ不要。
    '不正値対策は別途必要かな。
    Set ws = .Sheets.Add
    ws.Name = "QueryTable例"
    With ws.QueryTables.Add(Connection:="ODBC;DSN=Excel Files;DBQ=" & fName, _
                Destination:=ws.Range("A2"))
      .CommandText = "SELECT [担当者], [訪問先] FROM [Sheet1$]"
      .FieldNames = False
      .RefreshStyle = xlOverwriteCells
      .AdjustColumnWidth = False
      .Refresh False
      .CommandText = .CommandText & " WHERE ([日付]=?)"
      With .Parameters.Add("日付", xlParamTypeDate)
        .SetParam xlRange, ws.Range("A1")
        .RefreshOnChange = True
      End With
    End With
    ws.Range("A1").Value = "4月2日"
  End With
  
  Set ws = Nothing
End Sub

Sub sample1()
  With ActiveWorkbook.Sheets("AdvancedFilter例")
    .Parent.Sheets("Sheet1").Columns("A:C") _
        .AdvancedFilter Action:=xlFilterCopy, _
                CriteriaRange:=.Range("A1:A2"), _
                CopyToRange:=.Range("A3:B3")
  End With
End Sub

参考コードというより、サンプルBook。
一般機能の応用例として誰かの参考になればちょと嬉しいです:D
環境によってうまくいかなかったらスルーでお願いします。
    • good
    • 0
この回答へのお礼

ありがとうございます!できるようになりました!
本当にみなさんのおかげです。これを機にエクセルをもっと勉強してきます。本当にありがとうございました!

お礼日時:2010/04/17 21:37

シンプルに



SheetタブのSheet2を右クリック、コードの選択を選択
カーソルの位置へ下記マクロをコピペ
シートモジュールを閉じる

'Sheetモジュールへ
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i
If Target.Address = "$A$1" Then
Application.EnableEvents = False
Range("a2", Cells.SpecialCells(xlCellTypeLastCell)).ClearContents
With Worksheets("Sheet1")
For i = 1 To .Cells(Rows.Count, 1).End(xlUp).Row
If .Cells(i, 1).Value = Target.Value Then _
.Cells(i, 2).Resize(, 2).Copy Cells(Rows.Count, 1).End(xlUp).Offset(1)
Next
End With
End If
Application.EnableEvents = True
End Sub

Sheet2のA1へ入力して試してみてください
但し、Sheet1のA列が日付としています

参考まで
    • good
    • 0

以下のコードを、


・「標準モジュールではなく」「Sheet2のマクロ」として張ると、そのままできます。

Option Explicit

'プロパティ:検索対象のシート
Property Get 検索シート() As Worksheet
  Set 検索シート = ThisWorkbook.Worksheets("Sheet1")
End Property

'イベント:シート選択時
Private Sub Worksheet_Activate()
  'シート選択時の更新が不要なら、この部分は要らない
  Call Worksheet_Change(Me.Range("A1"))
End Sub

'イベント:値変更
Private Sub Worksheet_Change(ByVal Target As Range)
  '念のため、空チェック
  If Target Is Nothing Then
    Exit Sub
  End If
  
  'セルがA1かどうかをチェック
  Dim l_rngA1 As Range
  Set l_rngA1 = Target.Cells.Item(1)
  If (l_rngA1.Address(False, False) <> "A1") Then
    Exit Sub
  End If
  
  '最初に結果をクリアする
  Call 検索結果クリア
  
  'からっぽ
  If IsEmpty(l_rngA1.Value) Then
    Exit Sub
  End If
  
  '検索を行っていく
  Call 検索結果反映(l_rngA1.Value)
End Sub

'関数:検索結果クリア
Private Sub 検索結果クリア()
  Dim l_rng2行目以降 As Range
  
  '2行目以降の削除
  Set l_rng2行目以降 = Me.Rows("2:" & Me.Rows.Count)
  Call l_rng2行目以降.Delete
End Sub

'関数:検索結果反映
Private Sub 検索結果反映(ByVal p_検索値 As Variant)
  Dim l_rng検索A列  As Excel.Range
  Dim l_rngSarch As Excel.Range

  Dim l_lng件数  As Long
  Dim l_lngRow  As Long
  
  '検索シートのA列を取得
  Set l_rng検索A列 = Me.検索シート.Columns("A")
  
  'A列だけに限定して検索(検索引数は自分でカスタマイズ)
  Set l_rngSarch = l_rng検索A列.Find(p_検索値, LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows)
  If l_rngSarch Is Nothing Then
    '一件もないので終了
    Exit Sub
  End If
  
  Do
    '現在の行を記憶
    l_lngRow = l_rngSarch.Row
    
    'カウントアップ
    l_lng件数 = l_lng件数 + 1
    Call 出力マクロ(l_rngSarch, l_lng件数)
    
    'A列だけに限定して再検索
    Set l_rngSarch = l_rng検索A列.FindNext(l_rngSarch)
  
    '再検索結果が、先頭からの検索結果であれば抜ける
  Loop Until (l_rngSarch.Row <= l_lngRow)
End Sub

'関数:出力マクロ
Private Sub 出力マクロ(p_rngSarch As Range, p_lng件数 As Long)
  Dim l_rng出力先先頭 As Range
  Dim l_rng出力先   As Range
  
  '出力の先頭は、このシートのA2
  Set l_rng出力先先頭 = Me.Range("A2")
  
  '検索結果の件数目を考慮して、行を変更
  Set l_rng出力先 = l_rng出力先先頭.Offset(p_lng件数 - 1)
  
  '検索結果を出力していく
  l_rng出力先.Offset(, 0).Value = p_rngSarch.Offset(, 1).Value
  l_rng出力先.Offset(, 1).Value = p_rngSarch.Offset(, 2).Value
End
    • good
    • 0
この回答へのお礼

貴重な時間を使ってくださいまして大変ありがとうございます!!
このコードから、自分でいろいろ試してみたいと思います。
本当に、本当にありがとうございました!

お礼日時:2010/04/16 20:18

貼り付けてみて思った



こぴぺしただけだと
インデントつかないんだな・・

コードが見にくくなってしまってる

ご勘弁を・・
    • good
    • 0

オートフィルターじゃだめかな?


確かにそのままの状態だと不完全だけど 抽出データを見ることはできる

一応VBAだったら
下記のような感じになるが
プロシージャを書く場所とかコマンドボタンの配置、プロシージャの割り当て
なんかわからないだろう・・

考え方、手法は人それぞれだが・・

即席で作ってみた
貼り付けセル位置は適当なんでご勘弁


Sub テスト()
Dim i As Long
Dim cnt As Long
Dim Rastrow
Dim c As Range
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim Myday As Date
Dim Mydata() As Variant
Set ws1 = Worksheets("Sheet1")
Set ws2 = Worksheets("Sheet2")

Myday = ws2.Range("a2").Value
Rastrow = ws1.Range("a2").End(xlDown).Row

cnt = 0
For Each c In ws1.Range("a2:a" & Rastrow)
If c.Value = Myday Then
cnt = cnt + 1
End If
Next c

ReDim Mydata(1 To cnt) As Variant
i = 1
For Each c In ws1.Range("a2:a" & Rastrow)
If c.Value = Myday Then
Mydata(i) = ws1.Range("a" & c.Row & ":b" & c.Row).Value
i = i + 1
End If
Next c

For i = 1 To cnt
ws2.Range("a" & i + 1 & ":b" & i + 1).Value = Mydata(i)
Next

End Sub


そういえば ”アノ方”はVBA、VBAと言いながらいつまでたっても
コードアップしないね・・。
    • good
    • 0

●甲案:作業列と数式を使って素朴に。



1.シート1に作業列を作る

シート1のD1セルを
 =IF(A1=シート2!$A$1,ROW(),"")
として下方にフィル。

※該当する行にのみ行番号が表示されます。

2.シート2に結果を表示する

シート2のA2セルを
 =IF(COUNTIF(シート1!$A:$A,$A$1)<ROW()-ROW($A$1),"",INDEX(シート1!B:B,SMALL(シート1!$D:$D,ROW()-ROW($A$1))))
として右方,下方にフィル。

※ROW($A$1)の部分は、結果表示範囲の直上のセルを絶対参照で指定します。
※ROW()-ROW($A$1)の部分をROW(A1)のようにする人もいますが、コレは趣味の問題。

●乙案:数式一発で。

シート2のA2セルを
 =IF(COUNTIF(シート1!$A:$A,$A$1)<ROW()-ROW($A$1),"",INDEX(シート1!B:B,LARGE(INDEX((シート1!$A$1:$A$99=$A$1)/ROW(シート1!$A$1:$A$99),),ROW()-ROW($A$1))))
として右方,下方にフィル

●丙案:マクロで。

'-----↓ ココカラ ↓-------------------------------------------------
Sub Sample()

 Dim rtnRng As Range
 Dim keyDte As Date
 Dim orgAry As Variant
 Dim rtnAry As Variant
 Dim i   As Long
 Dim j   As Long
 Dim k   As Long
 
 '↓元データ範囲を指定
 orgAry = Worksheets("シート1").Range("A1:C999").Value
 '↓結果書出範囲を指定
 Set rtnRng = Worksheets("シート2").Range("A2:B999")
 '↓日付設定セルを指定
 keyDte = Worksheets("シート2").Range("A1")
 
 ReDim rtnAry(1 To rtnRng.Rows.Count, 1 To rtnRng.Columns.Count)
 
 For i = 1 To UBound(orgAry, 1)
  If orgAry(i, 1) = keyDte Then
   k = k + 1
   For j = 2 To UBound(orgAry, 2)
    rtnAry(k, j - 1) = orgAry(i, j)
   Next j
  End If
 Next i
 
 rtnRng.Value = rtnAry
 
End Sub
'-----↑ ココマデ ↑-------------------------------------------------

※元データ範囲はとりあえず固定にしています。
 データ数に応じて動的に取得することもできますが
 この処理では少々余分に見てもたいした負担ではないので…。
※元データ第1列がソートされている必要はありません。
※列数が増えても元データ範囲、結果書出範囲の指定を広げればそのままいけます。

以上ご参考まで。
    • good
    • 0

関数を使う方法だと、


【Sheet1】
  A   B   C
1 日付  担当者 訪問先
2 4月1日 佐藤  A
3 4月2日 鈴木  B
4 4月2日 加藤  C


例えば上記のようなセル位置関係だとして
【Sheet2】
B1 =MATCH(A1,Sheet1!A:A,0)
C1 =COUNTIF(Sheet1!A:A,A1)

という感じで作業用セルに数式を入れます。
あとは
A2 =IF(ROW()<$C$1+2,INDEX(Sheet1!B:B,$B$1+ROW()-2),"")
この式をB列及び必要行数分下へコピーすれば
一応お望みの形にはなります。
(Sheet1のデータが日付をキーに並べ替えてある事が条件です)


マクロで対応したいなら、前述例のようにSheet1の項目名をちゃんと設定し、
[フィルタオプション]を使うと良いです。
設定手順を[マクロの記録]すれば参考になると思います。


他の方法として、
自Book対象だけど[外部データの取り込み]を使えば、
パラメータ設定セルの変更時の自動更新ができるのでマクロも不要です。
ですがちょっと難易度があがりますので、自分が理解できる方法で取り組んでみて下さい。
    • good
    • 0

質問者は、最初からシート2で入力した日付で


別シートのシート1中から該当日付のデータを
シート2の指定したセルに出力したいと述べていますね。

質問者のスキルはわかりませんが、希望する内容
を実装するには、やはりVBAを勧めます。

習得するまでは、手作業ですが必要なセル範囲をコピー
するのではいけませんか?
質問があれば回答しますので。

一旦習得しまえば、今後にも生かせます。

VBA処理概要
1.シート1(データシート)A列に訪問日付、B列に訪問内容を記す。
2.シート2へ検索するコマンドボタンを付加する
3.シート2のボタンが押下されたら、シート1A列中より該当する
訪問内容がある分だけシート2の指定セルへデータ転記する。
    • good
    • 0

出力先が固定セルならVLOOKUPでもいいと思うが・・


A1セルをリスト形式の入力規制を設定して
リスト範囲は日付の行にしていすればいいかと
    • good
    • 0

>知ったかぶりか自慢にしか思えない



知ったかぶりでは無く、実際VBAでの解決法を知ってんだよ!

>質問者は素人と自ら申告しているのに何でVBA?

素人はVBAできないのか?
素人でも十分独学でVBAできる人もいる。
周りにもそういう奴らはいっぱいいる。
回答に対して
それをする、しない、文句を言うは質問者のすること。
つまらん事を書くヒマがあるなら、質問者への回答なり
ヒントを考えてやれよ!
    • good
    • 0
この回答へのお礼

回答ありがとうございます。
VBAでも大丈夫です。(少々調べた程度なので、まだまだですが)
日付を入力したら、別のシートにある同日付の内容を
表示できるようにしたいのです。
よろしくおねがいします。

お礼日時:2010/04/16 13:57

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

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

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

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

QVB.NET(ASP.NET)でページAからページBに新しいWindowで飛んだ後ページBにページAのDataGrid情報をもっていく方法

VB.NET(ASP.NET)のWebアプリケーションを
VB.NET2003で開発しているのですが
ページAに表示しているDataGridを新しいWindowで表示したページBのDataGridに表示させたいんです。
Session情報に入れようと思いましたが入らない・・
どうしたらよいでしょうか?

Aベストアンサー

お世話になります。

各画面で全く同じものを表示するのなら、
ユーザコントロールか、Web カスタムコントロールにしてしまうのが効率がよいと思います。
それで、その上で DataSource に使っている
DataSet やら DataTable やらを Session で渡すとか。

> Session情報に入れようと思いましたが入らない・・
これは具体的にどうして入らないのでしょうか。

QエクセルVBAでsheet1!B2:B10までの値をsheet2!B2

エクセルVBAでsheet1!B2:B10までの値をsheet2!B2:K2にコピーする方法を教えて下さい。

Aベストアンサー

>sheet1!B2:B10までの値をsheet2!B2:K2にコピーする

そもそもセルの個数が合ってませんが,何がしたいのですか?

基本:値の転送
worksheets("Sheet2").range("B2:J2").value = _
application.transpose(worksheets("Sheet1").range("B2:B10"))


個数を数えるところからやりたいならその通り数を拾って,resize等してください。
応用:
dim h as range
set h = worksheets("Sheet1").転送元のセル範囲縦一列
worksheets("Sheet2").range("B2").resize(1, h.rows.count),value = application.transpose(h)

Q日付の年の確認方法について A1セルに2017/4/1 コンボボックスに2018/4/1 と入ってい

日付の年の確認方法について

A1セルに2017/4/1
コンボボックスに2018/4/1
と入っています。この両方の年だけ等しいか確認するには rang("a1").Format(Date, "yyyy")=コンボボックス.Format(Date, "yyyy")で大丈夫ですか。
よろしくお願いします。

Aベストアンサー

年の比較であれば、
year(セル)
です。

Qセル式・indirectで他のシートを参照

早速ですが
=SUM(INDIRECT("g"&P25&":g"&P26)) 自分のシートは無問題
でも、
=SUM(INDIRECT("損益!M"&P25&":損益!M"&P26)) が #REF! となります。
p25,p26 は それぞれ 合計したい行の数値です。

最終は
=SUMIF(indirect("損益!M"&q25&":損益!M" &q26,">0", "損益!M"&q25&": 損益!M"&q26)))
これなのですが・・・・

どこで 間違ったのでしょうか
よろしくどうぞ

Aベストアンサー

こんにちは。
EXCELに関するご質問として、お応えします。

直接的な答えとしては、
=SUMIF(INDIRECT("損益!M"&Q25&":M"&Q26),">0",INDIRECT("損益!M"&Q25&":M"&Q26))
または一般的に、
=SUMIF(INDIRECT("損益!M"&Q25&":M"&Q26),">0")
というような結果をお求めなのかと思います。

SUMIF()関数の引数については、
第一引数と第三引数が同一のセル範囲を参照する場合、
第三引数を省略するのが通常です。

仮に、第三引数を指定する必要がある場合は、そちらも[セル範囲]を指定する必要がありますから、
[セル参照を表す文字列]を指定するのは誤りということになります。

INDIRECT()関数の引数には、ひとつ、セル参照を表す文字列を指定します。
構文上、INDIRECT()の括弧の中に、カンマで区切った複数の引数を指定するのは誤りです。

別シート上の(単一ではない)セル参照を表す方法の基本例ですが、
 損益!A2:A11
のように、
 「シート名」!「起点セル」:「終点セル」
という書式で書いた方が、演算上のロスも無く、エラーを起こす機会も減ります。
 損益!A2:損益!A11
のように書いても多くの場合で同じ結果を返すので、絶対にダメ、とまでは言いませんが。

ご質問冒頭の数式については、
=SUM(INDIRECT("損益!M"&P25&":M"&P26))です。
この書き方の場合、P25,P26が両方とも未入力だった場合に
=SUM(損益!M:M)の計算結果を返します。
例えば、
=SUM(INDIRECT("損益!M"&P25&":損益!M"&P26))のような指定をしてしまうと、
=SUM(損益!M:損益!M)という数式は成立しませんから、必然的に#REF!を返すことになります。

以上、ご参考まで。

こんにちは。
EXCELに関するご質問として、お応えします。

直接的な答えとしては、
=SUMIF(INDIRECT("損益!M"&Q25&":M"&Q26),">0",INDIRECT("損益!M"&Q25&":M"&Q26))
または一般的に、
=SUMIF(INDIRECT("損益!M"&Q25&":M"&Q26),">0")
というような結果をお求めなのかと思います。

SUMIF()関数の引数については、
第一引数と第三引数が同一のセル範囲を参照する場合、
第三引数を省略するのが通常です。

仮に、第三引数を指定する必要がある場合は、そちらも[セル範囲]を指定する必要がありますから、
[セル参照...続きを読む

Qエクセル A1の値と同じ値の入ったB列のC列の計

A1=10 D1=37
B C
10 15
11 10
10 12
12 1
10 10
A1と同じ値をB列から探し其の行のC列の値の合計をD1に表示したいのです
ご教授ください

Aベストアンサー

数式でやったほうが簡単ですが ・・・
=SUMIF(B1:B5,A1,C1:C5)
または
=SUMPRODUCT((B1:B5=A1)*1,C1:C5)

どうしてもVBAでというなら
標準モジュールに
Function mySum(rCnd as range, vSelect as variant, rSum as Range) as variant
  dim nCount as Long
  nCount = rCnd.rows.Count
  if nCount <> rSum.rows.Count then
    mySum = "---"
  else
    dim vC, vS
    dim n as Integer, value
    vC = rCnd.value
    vS = rSum.Value
    for n = 1 to nCount
      if vC(n,1) = vSelect then
        value = value + vS(n,1)
      end if
    next
    mySum = value
  end if
end Function
D1セルに =mySum(B1:B5, A1, C1:C5) といった数式を記述
といった具合です … 簡易なエラーチェックしかしていません

数式でやったほうが簡単ですが ・・・
=SUMIF(B1:B5,A1,C1:C5)
または
=SUMPRODUCT((B1:B5=A1)*1,C1:C5)

どうしてもVBAでというなら
標準モジュールに
Function mySum(rCnd as range, vSelect as variant, rSum as Range) as variant
  dim nCount as Long
  nCount = rCnd.rows.Count
  if nCount <> rSum.rows.Count then
    mySum = "---"
  else
    dim vC, vS
    dim n as Integer, value
    vC = rCnd.value
    vS = rSum.Value
    for n = 1 to n...続きを読む


人気Q&Aランキング

おすすめ情報