マンガでよめる痔のこと・薬のこと

初めまして。VBAで検索エンジンを作りたいのですが、作り方がわかりません。
仕事を頼まれましたが、VBAを勉強したことがなく困っています。

検索フォームにメーカー名、商品名、分類を入力すると、別シートにあるデータからショップ1、ショップ2、ショップ3のショップのデータが抽出される、といった内容です。

データベースである、ショップ1、ショップ2、ショップ3のシートにはそれぞれ1000件以上のデータがあります。このデータベースは月ごとに変動していくためCSVで取り込んで使いたいと思っています。

以上、説明が拙く申し訳ありませんがどうかご教授をお願いいたします。

「エクセル、VBAで検索するとデータベース」の質問画像

A 回答 (1件)

かなり難解ですね。

AccessやFileMakerではだめでしょうか。
エクセルVBAで実現するにはコードが複雑で可読性が悪く、メンテナンスはできないと思います。
データベースソフトなら簡単に柔軟に実現できます。VBAを使わずとも、基本機能のみでごく簡単に仕上がります。
    • good
    • 2
この回答へのお礼

ありがとうございます。Access、FileMakerを調べてみます!

お礼日時:2019/04/29 15:49

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

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

Q難問 Scriptin.Dictionary VBA Function.CountIfs

非常に難しいとは思いますが
できる方いましたら 
おしえてくれませんでしょうか

Scriptin.Dictionary
VBA WorksheetFunction.CountIfs
どちらでも構いません。やりたいこと
下記の表の内容で右表へ4月から6月への
AさんBさんの月別の集計をとりたい。
条件があり、 H列 J列  L列  一列おきです。
しかも、
     4月   5月  6月    ←行が件数の一行上です。
    件数  件数  件数
Aさん
Bさん
こういう表になっています。
                4月   5月  6月
A列  D列 G列    H列 J列  L列  一列おきです。
4/1   Aさん      Aさん   件数
5/1   Bさん      Bさん
4/10   Aさん
5/10   Bさん
6/1   Aさん
6/1   Bさん
6/10   Aさん
6/10   Bさん
7/1   Aさん
7/1   Bさん
7/10   Aさん
7/10   Bさん
8/1   Aさん
8/1   Bさん
8/10   Aさん

非常に難しいとは思いますが
できる方いましたら 
おしえてくれませんでしょうか

Scriptin.Dictionary
VBA WorksheetFunction.CountIfs
どちらでも構いません。やりたいこと
下記の表の内容で右表へ4月から6月への
AさんBさんの月別の集計をとりたい。
条件があり、 H列 J列  L列  一列おきです。
しかも、
     4月   5月  6月    ←行が件数の一行上です。
    件数  件数  件数
Aさん
Bさん
こういう表になっています。
             ...続きを読む

Aベストアンサー

No6です。
G列に名前を出力する処理が抜けていました。修正します。
----------------------------------------
Option Explicit

Sub 集計()
Dim dicT As Object
Dim maxrow As Long
Dim wrow As Long
Dim wcol As Long
Const max_person As Long = 1000 '最大人数
Dim price(max_person, 12) As Long '金額
Dim count(max_person, 12) As Long '件数
Dim pix As Long 'price&countへのindex
Dim ix As Long 'price&countへのindex
Dim key As Variant
Dim mm As Long
Dim cx As Long
pix = 1
Set dicT = CreateObject("Scripting.Dictionary") ' 連想配列の定義
maxrow = Cells(Rows.count, 1).End(xlUp).Row '1列目の最終行を求める
For wrow = 2 To maxrow
key = Cells(wrow, "D").Value
If dicT.exists(key) = True Then
ix = dicT(key)
Else
dicT(key) = pix
ix = pix
pix = pix + 1
End If
mm = Month(Cells(wrow, "A").Value) '月を算出
price(ix, mm) = price(ix, mm) + Cells(wrow, "E").Value '金額加算
count(ix, mm) = count(ix, mm) + 1 '件数加算
Next
wrow = 3
For Each key In dicT
ix = dicT(key)
Cells(wrow, "G").Value = key '①追加
For mm = 1 To 12
cx = mm - 4
If cx < 0 Then cx = cx + 12
wcol = 8 + 2 * cx
Cells(wrow, wcol).Value = count(ix, mm) '件数設定
Cells(wrow, wcol + 1).Value = price(ix, mm) '金額設定
Next
wrow = wrow + 1
Next
MsgBox ("完了")
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
①追加の行を追加しました。

No7の方へ
あなたのご指摘で、機能の漏れが判りました。ありがとうございました。

>やっぱ古いバージョンとは動きは違いますね。
>Dictionaryに全てのデータを纏めてG列の名前順で横一列に一気に吐き出す方法しか思い浮かばなかったです。

こちらでマクロはexcel2007で作成し、動作確認したものですが、
念のためexcel2003でも確認しました。こちらでも動作します。
古いバージョンの具体的なバージョンが不明ですが、(excel2003より前の場合は判りませんが)
少なくともexcel2003以上ならこのマクロは正しく動作します。

No6です。
G列に名前を出力する処理が抜けていました。修正します。
----------------------------------------
Option Explicit

Sub 集計()
Dim dicT As Object
Dim maxrow As Long
Dim wrow As Long
Dim wcol As Long
Const max_person As Long = 1000 '最大人数
Dim price(max_person, 12) As Long '金額
Dim count(max_person, 12) As Long '件数
Dim pix As Long 'price&countへのindex
Dim ix As Long 'price&countへ...続きを読む

Q日付関数

Sub SS()
Dim StartOfMonth As Date
Dim EndOfMonth As Date
Dim m As Long

For i = 3 To 5
For m = 8 To 12
StartOfMonth = DateSerial(2019, m, 1)
EndOfMonth = DateAdd("d", -1, DateAdd("m", 1, StartOfMonth))

Cells(i, m) = WorksheetFunction.CountIfs(Range("d2:d17"), _
Cells(i, 7), Range("a2:a17"), ">=" & DateSerial(2019, m, 1), _
Range("a2:a17"), "<=" & DateAdd("d", -1, DateAdd("m", 1, StartOfMonth)))

Next m
Next i
End Sub

Cells(i, 7), Range("a2:a17"), ">=" & DateSerial(2019, m, 1), _
Range("a2:a17"), "<=" & DateAdd("d", -1, DateAdd("m", 1, StartOfMonth)))
この部分2019/4/1から4/30
    2019/5/1から5/31
    2019/6/1から6/30にしたいのですが

For m = 8 To 12 

DateSerial(2019, m, 1), _
Range("a2:a17"), "<=" & DateAdd("d", -1, DateAdd("m", 1, StartOfMonth)))

だとDateSerial(2019, m, 1) 2019,8,1 当然なのですが
列が8列から始まっているが 開始月は4月なのです。
わかる方お願い致します。

すぐベストアンサーに致します。必ずです。

                   4月  5月 6月
A列  D列 G列    H列
4/1   Aさん      Aさん  件数
5/1   Bさん      Bさん
4/10   Aさん
5/10   Bさん
6/1   Aさん
6/1   Bさん
6/10   Aさん
6/10   Bさん
7/1   Aさん
7/1   Bさん
7/10   Aさん
7/10   Bさん
8/1   Aさん
8/1   Bさん
8/10   Aさん
8/10   Bさん

Sub SS()
Dim StartOfMonth As Date
Dim EndOfMonth As Date
Dim m As Long

For i = 3 To 5
For m = 8 To 12
StartOfMonth = DateSerial(2019, m, 1)
EndOfMonth = DateAdd("d", -1, DateAdd("m", 1, StartOfMonth))

Cells(i, m) = WorksheetFunction.CountIfs(Range("d2:d17"), _
Cells(i, 7), Range("a2:a17"), ">=" & DateSerial(2019, m, 1), _
Range("a2:a17"), "<=" & DateAdd("d", -1, DateAdd("m", 1, StartOfMonth)))

Next m
Next i
End Sub

Cells(i, 7), Range("a2:a17"), "...続きを読む

Aベストアンサー

前回の質問の回答者です。

For m =のループは、For i =のループの外側に書いてください。
m の変化は4~6です。

そして、Cells(i, m) はCells(i, m*2)と回答したはずですが。。。

回答した変更を導入するにしても、意味を理解してから実施してくださいね。

QエクセルVBA:繰り返し処理について

エクセルVBA初心者です。
どうかご指導お願いします。
シート1に入力されたデータベースの
j列から特定のコードで絞り込んで新しいシートに貼り付け作業を22回(特定のコードが22個あるため)行う方法を教えて下さい。

下記コードは「特定のコードで絞り込んで、シート2に貼り付け」だけをしたものですが、このコードを応用して作りたいです。
ご指導お願いします。

Sub test01()
With sheets("sheet1").Range("A1")
.AutoFilter Field:10, Criterial:"1126"
.CurrentRegion.Copy Sheets("sheet2").Range("A1")

可能ならば、シートではなく、別ブックに抽出されると尚嬉しいです。
よろしくお願い致します。

Aベストアンサー

こんにちは。

ご希望条件を実装するためには、特定のコードを配列変数に格納する必要があります。
しかしながら、配列変数に格納した場合、Autofilterを繰り返し行う必要はなくなります。
それを踏まえて、以下のようなコードを書いてみました。


Sub sample()
Application.DisplayAlerts = False

Dim s1 As Worksheet, s2 As Worksheet, nbook As Workbook
Set s1 = ThisWorkbook.Sheets("sheet1")
Set s2 = ThisWorkbook.Sheets.Add(After:=Sheets(Sheets.Count))
s2.Name = "抽出シート"
Set nbook = Workbooks.Add

Dim list As Range, cls As Range
Set list = Range("「特定のコード」をリスト化している範囲")
ReDim codeary(1 To 1) As String

For Each cls In list
  If codeary(UBound(codeary)) = "" Then
    codeary(UBound(codeary)) = CStr(cls.Value)
  Else
    ReDim Preserve codeary(1 To UBound(codeary) + 1)
    codeary(UBound(codeary)) = CStr(cls.Value)
  End If
Next cls

With s1.Range("A1")
  .AutoFilter Field:=10, Criteria1:=Array(codeary), Operator:=xlFilterValues
  .CurrentRegion.Copy s2.Range("A1")
End With

s2.Copy before:=nbook.Sheets(1)
nbook.Sheets(Sheets.Count).Delete
nbook.SaveAs Filename:=ThisWorkbook.Path & "\抽出.xlsx", _
             FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
nbook.Close savechanges:=False

s1.Range("A1").AutoFilter
s2.Delete

Application.DisplayAlerts = True
End Sub

もし「特定のコード」をリスト化していないのであれば、
1. ReDim codeary(1 To 1) As String → ReDim codeary(1 To 22) As String
2. For Each ~ Nextを削除し、
  codeary(1) = コード1個目
  codeary(2) = コード2個目
  ・・・・・・
  codeary(22) = コード22個目
としてください。

なお、新規ブックとしての保存は同じフォルダ内に「抽出.xlsx」としました。
変えたい場合は、「nbook.SaveAs Filename:=」以下を適宜変更してください。

こんにちは。

ご希望条件を実装するためには、特定のコードを配列変数に格納する必要があります。
しかしながら、配列変数に格納した場合、Autofilterを繰り返し行う必要はなくなります。
それを踏まえて、以下のようなコードを書いてみました。


Sub sample()
Application.DisplayAlerts = False

Dim s1 As Worksheet, s2 As Worksheet, nbook As Workbook
Set s1 = ThisWorkbook.Sheets("sheet1")
Set s2 = ThisWorkbook.Sheets.Add(After:=Sheets(Sheets.Count))
s2.Name = "抽出シート"
Set nbook = Workbo...続きを読む

Qこのマクロ

(自分) マクロについて教えてください。エクセル2010です。(A) C6:T6に
84.69.62.59.58.53.52.50.49.48.47.46.41.40(ここの数字は8~18個

の数字が入り、9個の時とか12個の
時もあります。)
そのデータ(数字は同じではなくその行ごとによって違う。が28行目まで同一の単位で2行飛びであり)

同一シートにある(B) C32:T32に84.69.62.58.53.52.50.49(ここの数字は8個の数字だけ。)
そのデータ(数字は同じではなくその行ごとによって違う。が54行目まで同一の単位で2行飛び出あり)
(A)と(B)を比較して(B)には表示されていない(A)の抜けている数字(ここでは59.48.47.46.41.40)に
色を付ける(緑)のマクロを教えて頂きたいです。あと出来たら空白にする(59.48.47.46.41.40)のも教え
て頂きたいです。宜しくお願いします。



(答えてくれた人)
貴方の言う2行飛びとは、2行空けることではないのですか。
先頭が、6行目で2行あけていくと、最後は27行目になりますが。
Bのエリアも同様です。

それから、AとBで対応する行の比較でいいのですね。
6行目は32行目と比較、9行目は35行目と比較というように


(自分)
お急がしい所回答有り難うございます。6行目は32行目、8行目は34行目、10行目は36行目、12行目は38行目、14行目は40行目...28行目は54行目までという感じです。
すいません2行ではなく1行飛びでした。
AとBで対応する行の比較です。


と質問してマクロを教えてもらったのですが、

Sub Sample()
Dim i As Integer, j As Integer
Dim rng As Range
For i = 6 To 28 Step 2
Set rng = Range("C" & i + 26 & ":T" & i + 26)
For j = 3 To 20
If Application.CountIf(rng, Cells(i, j)) > 0 Then
Cells(i, j).Interior.ColorIndex = 4
End If
Next j
Next i
End Sub

同じ表があり、(X6:AO6、AS6:BJ6、BN6:CE6、CI6:CZ6、DD6:DU6、
DY6:EP6、ET6:FK6)
にも同じ事をしたいのですが、5行目のCとTの所をXとAOにしても動きませんというか、色がつきません。

マクロを教えてください。宜しくおねがいします。

(自分) マクロについて教えてください。エクセル2010です。(A) C6:T6に
84.69.62.59.58.53.52.50.49.48.47.46.41.40(ここの数字は8~18個

の数字が入り、9個の時とか12個の
時もあります。)
そのデータ(数字は同じではなくその行ごとによって違う。が28行目まで同一の単位で2行飛びであり)

同一シートにある(B) C32:T32に84.69.62.58.53.52.50.49(ここの数字は8個の数字だけ。)
そのデータ(数字は同じではなくその行ごとによって違う。が54行目まで同一の単位で2行飛び出あり)
(...続きを読む

Aベストアンサー

ソースをきっちりと読んでいませんが

> For j = 3 To 20

の部分、3→"C"、20→"T"に対応しているので、
この数値も変更する必要があると思います。
(”X"→24みたいに)

QVBAでオブジェクトの名前に変数を用いる

Dim rng As Range, txtbox As Shape

Set rng = Range("A1")
Set txtbox = ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 1, 1, 100, 30)
text.Name = rng + "d"

この場合最後の行で変数 rng は無視されてテキストボックスの名前は「d」となります。

text.Name = Range("A1") + "d"
とか
text.Name = Cells(1,1) + "d"
とすると
名前は「(A1の内容)d」
となります。

この違いってどういうものなのでしょう。Range型変数を用いて「(A1の内容)d」とすることはできないのでしょうか。


もう1点だけ。
変数の型について
https://www.moug.net/tech/exvba/0150065.html
にあるObject型というのは
あらゆる種類のオブジェクトを格納できる、オブジェクトに関してはVariant的な存在なのでしょうか。

Dim rng As Range, txtbox As Shape

Set rng = Range("A1")
Set txtbox = ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 1, 1, 100, 30)
text.Name = rng + "d"

この場合最後の行で変数 rng は無視されてテキストボックスの名前は「d」となります。

text.Name = Range("A1") + "d"
とか
text.Name = Cells(1,1) + "d"
とすると
名前は「(A1の内容)d」
となります。

この違いってどういうものなのでしょう。Range型変数を用いて「(A1の内容)d」とすることはできないのでしょう...続きを読む

Aベストアンサー

No2です。

>A2とrngは参照という点で等価な気がしますが、難しい。
一方はオブジェクト、他方はセル位置を示す文字情報ですので、等価ではありません。
「Rangeはオブジェクトである」ということを忘れないでください。


>text.DrawingObject.Formula = "=rng" は動作せず
>text.DrawingObject.Formula = "=" & rng これは動作せず
>text.DrawingObject.Formula = rng ついでにこれも動作せず

いずれも関数式を設定するセンテンスで、右辺は関数式を意味する「文字列」である必要があります。
上記のうち、"=rng"は文字列ではありますが、そのまま "=rng"という意味になるので、関数式として理解されない可能性が高いです。
(エクセルはrngという名前の定義を探しますが、定義が見つからなければエラーになります)
その他は、オブジェクトを文字列であるかのように勘違いをしていると思われる記述になっていて、機械には解釈できない記述になっています。

なさりたいことは、Rangeオブジェクトが有しているセル位置の情報を文字列化した「A2」($A$2)を右辺に設定することではないでしょうか?
ですので、右辺を
 "=" & rng.Address
等とすることで、動作するようになると思います。
(rngオブジェクトが保持しているセル位置属性を明示的に示している)

No2です。

>A2とrngは参照という点で等価な気がしますが、難しい。
一方はオブジェクト、他方はセル位置を示す文字情報ですので、等価ではありません。
「Rangeはオブジェクトである」ということを忘れないでください。


>text.DrawingObject.Formula = "=rng" は動作せず
>text.DrawingObject.Formula = "=" & rng これは動作せず
>text.DrawingObject.Formula = rng ついでにこれも動作せず

いずれも関数式を設定するセンテンスで、右辺は関数式を意味する「文字列」である必要があります。
上記のう...続きを読む

Q【Excel VBA】複数のブックの指定シート指定位置の値を順次まとめていくマクロ

複数のブックの内容を取りまとめるマクロを作りたいです。

取りまとめ用ブックにてマクロを実行すると、フォルダの場所を聞いてきて、
指定フォルダ内にあるエクセルを順次処理するというイメージです。

フォルダ内にあるエクセルは、ファイル名には規則性がなくバラバラですが、
シート名や入力されたセル位置は全て統一されています。

シートが複数あるので、
シート1のセルC3、C5
シート2のセルA4、E10
シート3のセルB22、F32
シート4のセルG9
という感じに指定された場所の値を拾ってきたいのです。

取りまとめ用ブックの、
D4、E4、F4、G4、H4、I4、J4に、
シート1のC3、C5、シート2のA4、E10、シート3のB22、F32、シート4のG9と1行に値で貼り付けられ、
次のブックは、
D5、E5・・・と1行下にずれながらフォルダ内のブックを全て処理するイメージです。
実現可能でしょうか?

Aベストアンサー

こんばんは!

なかなか回答が付かないようなので、一例です。
コード記載ブックのSheet1に書き出すとします。
保存フォルダ内の対象ファイルの拡張子は「xlsx」としています。

Sub Sample1()
 Dim myPath As String, fN As String
 Dim wB As Workbook
 Dim cnt As Long

  myPath = "保存場所のパス" & "\"
  fN = Dir(myPath & "*.xlsx")
   cnt = 3
   Do Until fN = ""
    If fN <> ThisWorkbook.Name Then
     Workbooks.Open myPath & fN
      Set wB = ActiveWorkbook
      cnt = cnt + 1
       With ThisWorkbook.Worksheets("Sheet1")
        .Cells(cnt, "D") = wB.Worksheets(1).Range("C3")
        .Cells(cnt, "E") = wB.Worksheets(1).Range("C5")
        .Cells(cnt, "F") = wB.Worksheets(2).Range("A4")
        .Cells(cnt, "G") = wB.Worksheets(2).Range("E10")
        .Cells(cnt, "H") = wB.Worksheets(3).Range("B22")
        .Cells(cnt, "I") = wB.Worksheets(3).Range("F32")
        .Cells(cnt, "J") = wB.Worksheets(4).Range("G9")
       End With
      wB.Close
      fN = Dir()
    End If
   Loop
    MsgBox "完了"
End Sub

こんな感じではどうでしょうか?

※ コード内の「保存場所のパス」の部分は実際のパスにしてください。
もしコード記載のブックと同じフォルダ内に保存してあれば
>myPath = ThisWorkbook.Path & "\"

で構いません。m(_ _)m

こんばんは!

なかなか回答が付かないようなので、一例です。
コード記載ブックのSheet1に書き出すとします。
保存フォルダ内の対象ファイルの拡張子は「xlsx」としています。

Sub Sample1()
 Dim myPath As String, fN As String
 Dim wB As Workbook
 Dim cnt As Long

  myPath = "保存場所のパス" & "\"
  fN = Dir(myPath & "*.xlsx")
   cnt = 3
   Do Until fN = ""
    If fN <> ThisWorkbook.Name Then
     Workbooks.Open myPath & fN
      Set wB = ActiveWorkbook
...続きを読む

QExcelについてです L3に日付が入っていたらその日付を、日付が入っていなかったら今日の日付を返し

Excelについてです
L3に日付が入っていたらその日付を、日付が入っていなかったら今日の日付を返して欲しいのですが
こういう式を入力したら 41008 を返されました
どうすればいいですか?

Aベストアンサー

エクセルの日付は、1900年1月1日を1としたシリアル値で処理されます。表示がシリアル値になっているだけなので、書式設定から表示形式を日付に変えましょう。

Qエクセルの関数において、一つのセル内の一部分を判断してカウントする方法を教えて下さい

有給取得義務化が決定し、事前にスタッフから取得希望日を聞いて添付図の上の部分を入力しました。
(日付は4桁表記、同月に2日以上希望がある場合は「,」で区切り、同一セルに入力)
日付に被りが出ないように、添付図下のチェック表に自動的に上で入力した日付の数をカウントしたいと思っています。(図では数字をベタ打ちしましたが、実際は人数が多いので関数を用いて自動で表示したいです。)
B14セルにCOUNTIF(B$4:B$9,B$13&$A14)を入力して図の下部分すべてに数式をコピペすると、一つのセルの中に日付が一つしか入力されていないもの(例えばB4)に関してはカウントしてくれますが、二つ以上入力されているもの(例えばB5)に関してはどちらの日付もカウントしてくれませんでした。
ワイルドカード等を用いれば出来るのかなと思いましたが、全くわかりませんので教えて頂きたく質問させて頂きます。
尚、図の上の部分は指定されたフォーマットですのでいじることが出来ません。

宜しくお願い致します。

Aベストアンサー

No1です

連投失礼。
すみません、もっと簡単にできましたね。
 =COUNTIF(B$4:B$9,"*"&B$13&$A14&"*")

Qプログラミングの課題で1万円からから支払い金額を入力して残金が0になると終了するプログラムを作ったの

プログラミングの課題で1万円からから支払い金額を入力して残金が0になると終了するプログラムを作ったのですが、「1000円支払いごとに100円のキャッシュバック」を追加したいのですがわかりません。誰か教えてください。

Aベストアンサー

n=n-m; の次の行に
n=n+(m/1000)*100;
を追加してください。
尚、次回、C言語について質問するときは C言語・C++・C# のカテゴリに投稿すると良いでしょう。

Q連続する複数のセル値がすべて0であることを判定するマクロ

初心者の質問です。
エクセルでⅭ列にはAとBの差額が計算されています。
Ⅽ1からⅭ6の全てのセル(6個)がそれぞれ0である場合にOKとなるマクロを教えてください。
+と-が同額の場合、Ⅽ8の合計が0となるので、Ⅽ8の値で判断できない場合があるためです。
 
Sub 確認()
If ActiveSheet.Range("C1:C6").Value = 0 Then  ←この箇所がエラーになります。
MsgBox "OK"
Else
MsgBox "NG"
End If
End Sub

よろしくお願いします。

Aベストアンサー

マクロを使わない方法もあります。セルC9などの適当な空いてるセルに以下の式を入れます。

=IF(COUNTIF(C1:C6,"=0")=6,"OK","NG")

できるだけマクロは使わないで、ワークシート関数で対応する方法を考えるべきだと私は思っています。

ちなみにVBAでRangeを使った場合、今のような式でエラーにならないのは含まれるセルが1個の時だけです。セル範囲を指定した場合はセル範囲の個数と同じ大きさの配列変数が必要になるし、その中身を調べるには1個ずつループで取り出して比較するしかないので、面倒です。

というわけでこのCOUNTIF関数をVBAから使えればそれが一番楽ちんだということになります。以下みたいにすればできます。

If Application.WorksheetFunction.CountIf(Range("C1:C6"), "=0")=6 Then


人気Q&Aランキング