下記のようなデータベースがあります。A列からT列までにデータが入っています。
D列に下記のデータがあります。頭2桁がADのものだけを検索したい場合は、マクロでは
どう記述すればいいでしょうか。教えてください。
AA0G120Y0000
AA0H12000000
AA0S01000000
AA0S03B00000
AA0S05A00000
AD120000110000000P
AD120000110000000P
AD120000110000000P
AD120000110000000P

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

A 回答 (3件)

>・・・データベースがあります。

A列からT列までにデータが入っています。
もしかしてExcel?Excelでなかったら、破棄してください。

Filter、Find-FindNext などいろいろありますが、検索して検索結果をどうすればいいかわからないので、検索したセルを選択状態にしてみました。
これは検索というよりも照合しています。D列の2行目から下に検索しています。ご参考に。(Excel97です)

Sub Kensaku()
  Dim rg As Range 'セル
  Dim FoundCell As Range '検索セル
  Dim maxRow As Long '検索する最終行
  Dim schRg As String '検索範囲
  Const schCol = "D" '検索列
  Const schStr = "AD" '検索文字

  '検索範囲
  maxRow = Range(schCol & "65536").End(xlUp).Row
    If maxRow = 1 Then Exit Sub
  schRg = schCol & "2:" & schCol & maxRow
  '検索実行
  With Worksheets("Sheet1")
    For Each rg In .Range(schRg)
      '左から2文字を比べる
      If Left(rg, 2) = schStr Then
        '一致した場合
        If FoundCell Is Nothing Then
          '1個目
          Set FoundCell = rg
        Else
          '2個目以降
          Set FoundCell = Union(FoundCell, rg)
        End If
      End If
    Next
  End With
  '検索したセルを選択状態にする
  If Not FoundCell Is Nothing Then
    FoundCell.Select
  End If
End Sub
    • good
    • 0

エクセルの表だと仮定します。

A列にデータが入っているとします。(本題ではD列だが説明を単純にするために)
B列、C列も空きの列で有ると仮定します。B列に1より連続番号を振ります。(B1に1、B2に2を入力し、B1とB2を範囲指定して、右下の+を最下行まで引っ張っれば良い。)
C1列に「=IF(MID(A1,1,2)=”AD”,A1,””)」と式をいれ、C2から最下行まで式の複写をします。
すると、C列はブランクのセルと、AD・・・のセルの2種類となります。
B列とC列について、C列の降順で並べ替えます。上部にAD・・のセルが残ります。そこでAD・・のセルだけをB列とC列について、B列の連番で昇順に並べかえるとA列の順序を保存したままで、上部にAD・・・のデータが残ります。
これでいかがですか。難しいVBAは使わない方法です。
    • good
    • 0
この回答へのお礼

ありがとうございました
参考になりました。

お礼日時:2002/04/03 09:20

データーベースソフト名が分りませんが、MS Accessなら以下のクエリーになります。


SELECT * FROM テーブル WHERE left(D,2)='AD';
    • good
    • 0

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

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

QExcel2013 VBA A列とB列の文字をA列とB列とC列に移動させる方法

A列とB列に文字が入っているのですが、下記のようにA列とB列とC列に文字を移動させたいです。
(A列の数字は必ず奇数のA列に入っています。)
VBAのコードを教えて下さい。

例えば
A1 1  B1 cat
A2 空白 B2 猫
A3 空白 B3 dog
A4 空白 B4 犬
A5 2  B5 whale
A6 空白 B6 クジラ
A7 3  B7 rabbit
A8 空白 B8 ウサギ

とデータがある場合

A1 1  B1 cat  C1 猫
A2 空白 B2 dog  C2 犬
A3 2  B3 whale  C3 クジラ
A4 3  B4 rabbit C4 ウサギ

としたいです。

実際、データは、A5196まであります。

Aベストアンサー

No.1です。

>実際、データは、A5196まであります。

前回のコードは一つずつカット&ペーストしていますので
かなりの時間を要すると思います。
↓のコードに変更してみてください。

Sub Sample2()
Dim lastRow As Long
lastRow = Cells(Rows.Count, "B").End(xlUp).Row
Application.ScreenUpdating = False
With Range(Cells(1, "C"), Cells(lastRow, "C"))
.Formula = "=IF(MOD(ROW(),2)=1,B2,"""")"
.Value = .Value
.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
Application.ScreenUpdating = True
MsgBox "完了"
End Sub

少しは短縮できると思います。m(_ _)m

No.1です。

>実際、データは、A5196まであります。

前回のコードは一つずつカット&ペーストしていますので
かなりの時間を要すると思います。
↓のコードに変更してみてください。

Sub Sample2()
Dim lastRow As Long
lastRow = Cells(Rows.Count, "B").End(xlUp).Row
Application.ScreenUpdating = False
With Range(Cells(1, "C"), Cells(lastRow, "C"))
.Formula = "=IF(MOD(ROW(),2)=1,B2,"""")"
.Value = .Value
.SpecialCells(xlCellTypeB...続きを読む

Qエクセルで、A列に日付をB列に曜日、C列からF列までにデータを入れるよ

エクセルで、A列に日付をB列に曜日、C列からF列までにデータを入れるように作成しています。
条件付書式で土日祭日の場合はC列からF列に色を表示させています。
この色付セル(土日祭日)の場合にはデータ入力が無いので自動で0を表示させ、なおかつデータ入力が出来ないようにしたいのですが、そのようなことは出来るでしょうか。エクセルは2003を使ってます。

Aベストアンサー

C2セルに以下の数式を入力します。

=IF(AND($A2<>"",WEEKDAY($A2,2)>5),0,"")

同様にC2セルに以下の入力規則を設定します。

「データ」「入力規則」で「ユーザー設定」にして数式欄に以下の式を入力します。

=WEEKDAY($A2,2)<6

最後にC2セルを右方向および下方向にオートフィルします。

Q行のデータ(a列b列c列)をd列に表示したい

a1、b1、c1のセルに入力したデータをd1セルに表示したい。可能でしょうか。一例「a1セルに1と入力、b1セルに2と入力、c1セルに3と入力しd1セルに123と表示する」

Aベストアンサー

d1セルに =a1&b1&c1

エクセルですよね?

QA列とB列の重複を抽出したいのですがA列とB列の値は一部だけ同じ文字です。ご教示お願いします。

エクセル初心者です。重複を見つけるのが仕事です。いろいろやってみたのですがうまくできません。
お知恵をお貸しください。

A列には企業名が入力されています。
B列にも企業名が入力されていますが全く同じ文字ではないのです。

たとえばこういうことです。
A1 (有)雪見酒      B1  雪見
A2 株式会社豪雪地帯   B2 (株)豪雪地帯
A3 ゆきかき本舗     B3 (有)ゆきかき本舗

A列にある企業名とB列にある企業名が同じであればセルを塗りつぶすか○を表示させるように
したいのです。
重複を見つけるのが目的なので、ほかの方法でもかまいません。
すみません、A列のセルとB列のセルが全く同じ名前ならば重複が見つけられたのですが
ここから先がどうしてもわからないのです。。。
申し訳ありませんがどうか教えてください。。。

Aベストアンサー

No4です。以下のマクロを標準モジュールへ登録してください。
--------------------------------------------------
Option Explicit
Public Sub 重複チェック()
Dim maxrow1 As Long
Dim maxrow2 As Long
Dim row1 As Long
Dim row2 As Long
Dim nameT1() As String
Dim nameT2() As String
Dim t1, t2 As Variant
t1 = Time
maxrow1 = Cells(Rows.Count, "A").End(xlUp).row '最大行取得
maxrow2 = Cells(Rows.Count, "B").End(xlUp).row '最大行取得
ReDim nameT1(maxrow1)
ReDim nameT2(maxrow2)
Range("C1:" & "D" & maxrow2).Value = ""
Call makeTable(nameT1, "A", maxrow1)
Call makeTable(nameT2, "B", maxrow2)
For row1 = 1 To maxrow1
For row2 = 1 To maxrow2
If Cells(row2, "C") = "" Then
If Mymatch(nameT1(row1), nameT2(row2)) = True Then
Cells(row2, "C").Value = "○"
Cells(row2, "D").Value = row1
End If
End If
Next
Next
t2 = Time
MsgBox ("チェック完了 処理時間=" & Minute(t2 - t1) & "分" & Second(t2 - t1) & "秒")
End Sub
'余分な文字を削除した結果をテーブルに格納する
Private Sub makeTable(ByRef nameT() As String, ByVal col As String, ByVal maxrow As Long)
Dim row As Long
Dim ary As Variant
Dim name As String
Dim i As Long
ary = Array("㈱", "(株)", "株式", "(有)", "有限", "会社")
For row = 1 To maxrow
name = Cells(row, col).Value
For i = 0 To UBound(ary)
name = Replace(name, ary(i), "")
Next
nameT(row) = name
Next
End Sub
'企業名が一致かどうか判定する
Private Function Mymatch(ByVal name1 As String, ByVal name2 As String) As Boolean
Mymatch = False
Dim pos As Variant
pos = InStr(1, name1, name2, vbTextCompare)
If pos > 0 Then Mymatch = True
End Function
-----------------------------------------------------
一致の精度が悪ければその旨補足してください。
(一致すべきものが一致しない、一致してはいけないものが一致している)
100%解決できる保証はありませんが、多少のチューニングは行います。

No4です。以下のマクロを標準モジュールへ登録してください。
--------------------------------------------------
Option Explicit
Public Sub 重複チェック()
Dim maxrow1 As Long
Dim maxrow2 As Long
Dim row1 As Long
Dim row2 As Long
Dim nameT1() As String
Dim nameT2() As String
Dim t1, t2 As Variant
t1 = Time
maxrow1 = Cells(Rows.Count, "A").End(xlUp).row '最大行取得
maxrow2 = Cells(Rows.Count, "B").End(xlUp).row '最大行取得
ReDim ...続きを読む

QA~H列までデータをA列だけに入れる方法

以下のHPのデータがあります。


http://www.geocities.jp/etctransformation/newpage9.html


現在A~H列までデータが入っていますが、A列だけに

A列
Fe[26, 45] = 45.01458;
Fe[26, 46] = 46.00081;
Fe[26, 47] = 46.99289;
Fe[26, 48] = 47.9805;
Fe[26, 49] = 48.97361;
Fe[26, 50] = 49.96299;
Fe[26, 51] = 50.95682;
Fe[26, 52] = 51.948114;

のように、データを入れる方法を教えて下さい。

Aベストアンサー

Sheet1にA~Hまでデータは入っているとします。
1行目は見出しでなくデータとします。
これをSheet1のA列にまとめることとします。
以下のようになります。
------------------------------
Public Sub 列まとめ()
Dim sh1, sh2 As Worksheet
Dim row, maxrow As Long
Set sh1 = Worksheets("Sheet1")
Set sh2 = Worksheets("Sheet2")
maxrow = sh1.Cells(Rows.Count, 1).End(xlUp).row
For row = 1 To maxrow
sh2.Cells(row, 1).Value = sh1.Cells(row, 1).Value & sh1.Cells(row, 2).Value & sh1.Cells(row, 3).Value & sh1.Cells(row, 4).Value & sh1.Cells(row, 5).Value & sh1.Cells(row, 6).Value & sh1.Cells(row, 7).Value & sh1.Cells(row, 8).Value
Next
MsgBox ("完了")
End Sub
------------------------------------

Sheet1にA~Hまでデータは入っているとします。
1行目は見出しでなくデータとします。
これをSheet1のA列にまとめることとします。
以下のようになります。
------------------------------
Public Sub 列まとめ()
Dim sh1, sh2 As Worksheet
Dim row, maxrow As Long
Set sh1 = Worksheets("Sheet1")
Set sh2 = Worksheets("Sheet2")
maxrow = sh1.Cells(Rows.Count, 1).End(xlUp).row
For row = 1 To maxrow
sh2.Cells(row, 1).Value = sh1.Cells(row, 1).Value & sh1.Cells(ro...続きを読む


人気Q&Aランキング

おすすめ情報