みなさんはじめまして。
先日より必要に駆られてエクセルのマクロを使い始めた初心者です。
なかなか独学ではうまくいかず、
皆さんのお知恵を拝借したくお願いします。

したいことは以下の通りです。
検索シートに検索会社を入力すると、一部でも一致するデータを
顧客データが入った別シートから検索し、
検索シートにリストアップすると言うことがしたいです。
データシートには
 A列  B列   C列   D列    E列     F列
 分類  会社名  担当者  電話番号 詳細へハイパーリンク 業務内容
 ----  ●社   Aさん  123-4567  ******    XXXX
 ----  ×社   Bさん  234-5678  ******    ????
 ----  △社   Cさん  345-6789  ******    !!!!!
などのようにデータが300社くらい入っています。
一応自分で下記のようなマクロを組んでみたのですが、
リストアップされたデータのハイパーリンクの部分が文字列になってリンクとして使えません。
解消方法、またはもっと良いマクロがあれば教示お願いします

Sub 検索()
Dim tmp As Range
Dim y As Integer, a, firstAddress
'***** 結果を表示する部分をクリアします
Sheets("検索").Range("A7:ag65536").ClearContents
'***** キーワードを取得
a = InputBox("検索会社名を入力してください")
'***** キーワードを含むデータを検索
Set tmp = Sheets("検索元データ").Columns(3).Find(a, , , xlPart)
If tmp Is Nothing Then
'***** 見つからない場合
MsgBox "一致するデータはありません"
Else
'***** 見つかった場合
firstAddress = tmp.Address
y = 7
'***** 他にもあるか探してあれば記載
Do
Sheets("検索").Range("c" & y) = tmp
Sheets("検索").Range("b" & y) = tmp.Offset(0, -1)
Sheets("検索").Range("d" & y) = tmp.Offset(0, 1)
Sheets("検索").Range("e" & y) = tmp.Offset(0, 2)
Sheets("検索").Range("f" & y) = tmp.Offset(0, 3)
Sheets("検索").Range("g" & y) = tmp.Offset(0, 4)
Sheets("検索").Range("h" & y) = tmp.Offset(0, 5)
Sheets("検索").Range("i" & y) = tmp.Offset(0, 6)
Sheets("検索").Range("j" & y) = tmp.Offset(0, 7)
Set tmp = Sheets("検索元データ").Columns(3).FindNext(tmp)
y = y + 1
Loop Until tmp.Address = firstAddress
End If
End Sub

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

A 回答 (3件)

書式もコピーしてしまってよければ、対象レンジをまとめてコピーしちゃうのが一番簡単です


 tmp.Offset(0, -1).Resize(1, 9).Copy (Worksheets("検索").Range("B" & y))

書式はコピーしたくないのであれば、ハイパーリンクだけ別にコピーするとして(E列ですよね?)
 Worksheets("検索").Range("B" & y).Resize(1, 9).Value = tmp.Offset(0, -1).Resize(1, 9).Value
If tmp.Offset(0, 2).Hyperlinks.Count > 0 Then
 Worksheets("検索").Hyperlinks.Add Anchor:=Worksheets("検索").Range("E" & y), Address:=tmp.Offset(0, 2).Hyperlinks(1).Address
End If
みたいな感じ。(列などがずれていたら訂正願います)
    • good
    • 0
この回答へのお礼

書式コピーで全然問題ないです。
やってみたところばっちりでした。
ありがとうございます

お礼日時:2009/05/22 17:25

これでいかがでしょう?



Sub 検索02()
Dim tmp As Range
Dim y As Integer, a, firstAddress
'***** 結果を表示する部分をクリアします
Sheets("検索").Range("A7:AG65536").ClearContents
'***** キーワードを取得
a = InputBox("検索会社名を入力してください")
'***** キーワードを含むデータを検索
Set tmp = Sheets("検索元データ").Columns(3).Find(a, , , xlPart)
If tmp Is Nothing Then
'***** 見つからない場合
MsgBox "一致するデータはありません"
Else
'***** 見つかった場合
firstAddress = tmp.Address
y = 7
'***** 他にもあるか探してあれば記載
Do
tmp.Offset(0, -1).Resize(, 9).Copy Sheets("検索").Range("b" & y).Resize(, 9)
Set tmp = Sheets("検索元データ").Columns(3).FindNext(tmp)
y = y + 1
Loop Until tmp.Address = firstAddress
End If
End Sub
    • good
    • 0
この回答へのお礼

すみません。
上記式だとエラーがかかってしまいました。

とりあえず下記のお二方の方法にて対応できましたので
今回はこれでいこうと思います。
また何かありましたら、よろしくお願いします。

お礼日時:2009/05/22 17:32

代入ではハイパーリンクや書式は移動できませんので、コピーしてください。



Sheets("検索").Range("c" & y) = tmp
Sheets("検索").Range("b" & y) = tmp.Offset(0, -1)
Sheets("検索").Range("d" & y) = tmp.Offset(0, 1)
Sheets("検索").Range("e" & y) = tmp.Offset(0, 2)
Sheets("検索").Range("f" & y) = tmp.Offset(0, 3)
Sheets("検索").Range("g" & y) = tmp.Offset(0, 4)
Sheets("検索").Range("h" & y) = tmp.Offset(0, 5)
Sheets("検索").Range("i" & y) = tmp.Offset(0, 6)
Sheets("検索").Range("j" & y) = tmp.Offset(0, 7)

上記の転記部分を下記の1行と入れ替える
 
tmp.EntireRow.Copy Sheets("検索").Range("A" & y)

 
 
    • good
    • 0
この回答へのお礼

やってみたらばっちり出来ました。
ありがとうございます。

お礼日時:2009/05/22 17:27

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

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

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

Q検索するときgooが選べなくなりました

いつもweb検索するときは、(win使用)
インターネットエキスプローラの検索ボタンから、
左側にgooを出して検索行っていたのですが、
今日はgooが選べません。
gooのホームページ自体は開きます
検索設定のカスタマイズ行うとき、
その一覧の中にgoo自体がありません。
インターネットオプションでweb設定のリセットを行いましたが、
変わりませんでした。
おやおや?と思い他のPCで検索試しましたところ、
そちらでもブラウザの検索ボタンでgooがでてきません。
みなさんはいかがですか?

Aベストアンサー

失礼します。

窓の杜の今日のお気に入りで見たのですが、IEに検索ツールバーを装着できる「IE WORDER」というソフトがありました。
64の検索サービスサイトを利用可能だそうです。gooもあります。
http://www.forest.impress.co.jp/article/2002/04/09/ieworder.html

また、gooのツールバーもIEにインストールすることができます。
http://www.nttx.co.jp/tvcm/infinity/getyou/

その他の検索ツールバーのリンク集です。
http://www.robot-search.com/toolbar.htm

Q=IF(Sheet1!MX9="", "",Sheet1!MX9) で表した結果に条件付き書式を

こんにちは、エクセル2010を使っています。

A1セル
=IF(Sheet1!MX9="", "",Sheet1!MX9) B1セル =IF(Sheet1!MY9="", "",Sheet1!MY9)
と数式が入っていて、結果が 29% 36% などとなって居ます。

このセルに、【30%以上の場合は】と条件を与えても動作するどころか空白まで全てに条件が適用されてしまいます。

これを通常通り条件付き書式を与えるにはどうしたら良いでしょうか。

詳しい方、よろしくお願いいたします。

Aベストアンサー

少し面倒ですが、現状のA1、B1の計算式を変えない方法として
条件付き書式をいじってみては?

A1を選択して 条件付き書式 → 新しいルール → 数式を使用して、書式設定するセルを決定 を選択
下部に表示されたテキストボックスに、
=VALUE(A1)>=0.3 (0.3は30%の意)
と入力、設定したい書式を選択して設定する

あとは、A1のセルをコピー、B1に書式のみ貼り付けでOK

QGoogle Chromeでgoo複合検索に飛ばないようにしたい

 2008年11月5日から、Google Chromeでgooのウェブ検索をすると、勝手にgoo複合検索を行うようになりました。
 この複合検索が凄く不便なので、通常のウェブ検索に切り替えたいのです。

 複合検索で、右上にある「goo検索(通常版)」というリンクを押すといったんは通常検索になりますが、11件目以降を見ようとして「次の結果」を押すと、また複合検索に戻ってしまい、そこで「goo検索(通常版)」を押すと1件目の検索結果に戻ってしまいます。
 そんなわけで、いつまでたっても通常検索で11件目以降の検索結果を見ることができません。

 Google Chromeでもこれまでどおり通常のウェブ検索ができるようにしたい(というか、勝手に複合検索に飛ばないようにしたい)のですが、よい方法をご存知でしたら教えてください。
 よろしくお願いします。

Aベストアンサー

Chromeのオプションにある「既定の検索エンジン」の選択項目には、Goo検索がないですから、特別仕様ではないですか。

複合検索の画面に、「Google Chromeをお使いのみなさまに最新の検索を提供中(NEW)」との表示が出ますね。
ブラウザを自動判定して、強制的に複合検索の画面に持っていくようになっているような動きですね。

検索オプションの設定にも、恒常的に通常版を使用するような箇所は見当たらないようです。

QExcel でシート間の重複データ(Sheet1のA=Sheet2のA かつ Sheet1のB=Sheet2のB)

Excel2000です。

Sheet1のA列・B列・C列・・・にデータが入っています。
Sheet2のA列・B列・C列・・・にデータが入っています。

Sheet1のA列とSheet2のA列は、似たようなデータが入っています。
Sheet1のB列とSheet2のB列も、同様です。
C列以降のデータは、シート間で全然関係ありません。

Sheet1の行データ(A列・B列)が、Sheet2(A列・B列)にも存在しているかどうか、
を知るには、どうすればよいですか。
C列以降の列のデータは、比較する際に使いません。

つまり、
Sheet1のA = Sheet2のA
かつ
Sheet1のB = Sheet2のB
であるような行を知りたいのですが、

どうすればよいのでしょうか。

Aベストアンサー

Sheet1、Sheet2 ともに空いている列に =A1&B1 のような連結データを作り、Matchなどで比較するとか、、、

Sheet1 の E1 =A1&B1
Sheet2 の E1 =A1&B1
Sheet1 の F1 =MATCH(E1,Sheet2!E:E,0)

Qgoo検索スティックがBookshelfのホットキー検索を妨害する?

どうしてもBookshelfのホットキー検索が使いたいのですが出来ません。それでふと思ったのですが、単語を範囲指定して反転させて右クリックしたら、goo 関係の検索一覧が表示され、[Bookshelfの検索]が表示されません。数ヶ月前からgooの検索スティックを上部に常駐させています。例えば、Yahoo検索している時でも、すぐにgoo検索ができるというものです。これがいけないのでしょうか? よろしくお願いします。

Aベストアンサー

IEの右クリックメニューに関する質問だと思いますが、IEの右クリックメニューには選択テキストからのものだけでなく、リンクからのダウンロードなどを含めて、合計で32個までしかレジストリーに登録できません。あるいは、色々なソフトをインストールしたために、その数をオーバーし、Bookshelfが追い出されたのではないでしょうか。IEの右クリックメニューを編集する、IEMenuExtというフリーソフトがありますが、それを使うと、32個を超えるメニューをレジストリーとは別に管理でき、必要に応じてレジストリーに登録するメニューを入れ替えることができます。http://www.uryusoft.com/software/
からダウンロードできます。なお、すでに消えたBookshelfのメニューはそこには表示されないと思うので、次のファイル名で新規作成してください。名称はわかりやすいものをつけてください。適用される項目は「テキスト選択時」にチェックを入れてください。res://C:\Program Files\Microsoft Reference\Microsoft Bookshelf 3.0\bsdef.dll/#1001

IEの右クリックメニューに関する質問だと思いますが、IEの右クリックメニューには選択テキストからのものだけでなく、リンクからのダウンロードなどを含めて、合計で32個までしかレジストリーに登録できません。あるいは、色々なソフトをインストールしたために、その数をオーバーし、Bookshelfが追い出されたのではないでしょうか。IEの右クリックメニューを編集する、IEMenuExtというフリーソフトがありますが、それを使うと、32個を超えるメニューをレジストリーとは別に管理でき、必要に応じてレジストリーに...続きを読む

Q=IF(ISNA(VLOOKUP($A1,sheet2!$A$1:$B$12,2,FALSE)),"",VLOOKUP($A1,sheet2!$A$1:$B $

いつもお世話になってます。
以下の関数式について、お時間がありましたらどうぞご教示ください。

=IF(ISNA(VLOOKUP($A1,sheet2!$A$1:$B$12,2,FALSE)),"",VLOOKUP($A1,sheet2!$A$1:$B $12,2,FALSE))

「シート2の範囲指定した表にA1セルの値と同じ値の右隣になる値を返せ。ただし該当なき場合は空白とせよ。」

純粋になんでこのような構文になるのかが解りません。

1.ISNAってそもそもなんでしょう?
2.同じ式を繰り返すのはなぜ?
(模範式で、このように同じ式を繰り返す構文があまり無いように思えたのです。)

・参考となる他所のページがあれば教えて下さい。
・素人です。お手柔らかにお願いします。

(エクセル2003)

Aベストアンサー

1.ISNAってそもそもなんでしょう?
ISで始まる情報関数の一つで、#N/A!エラーのみを判定する関数
結果はTRUE(真),FALSE(偽)のいずれかになります。
エラー判定のIS関数には他に
ISERR:#N/A!を除くすべてのエラーを判定する関数
ISERROR:すべてのエラーを判定する関数
があります。

2.同じ式を繰り返すのはなぜ?
ISNAの判定する値がセルでなく数式の結果だからです。
A2=VLOOKUP($A1,sheet2!$A$1:$B$12,2,FALSE)
なら
A3=IF(ISNA(A2),"",A2)
ということになります。A2のように計算の為のセルを省略する為に
=IF(ISNA(数式),"",数式)のように同じ数式を2回繰り返しになってます。

Qgooブログ内を検索する方法

これからgooブログをはじめようと思っています。いろいろなブログを検索したり、なかでもgooブログだけを検索する方法を教えてください。

Aベストアンサー

googleのオプション検索でドメインを指定して検索すれば可能だと思います。
https://www.google.com/advanced_search
サイトまたはドメイン:のところに
http://blog.goo.ne.jp/
を入れて、検索キーワードを入れて検索して下さい。

もしくは
site:blog.goo.ne.jp キーワード
で検索してみてください。
http://enjoy.sso.biglobe.ne.jp/archives/google_serch/

QExcel2013 VBA sheet1とsheet2のデータを合成してsheet3を作るには

sheet1に氏名、sheet2にその氏名の人の趣味が入っています。

新たにsheet3を作成して、
氏名1
趣味
氏名1

氏名2
趣味
氏名2

氏名3
趣味
氏名3

氏名4
趣味
氏名4

としたいです。
VBAのコードを教えて下さい。

例えば
①sheet1には
A1;1 B1;阿部 C1;あべ
A2;2 B2;佐藤 C2;さとう
A3;3 B3;山名 C3;やまな
A4;4 B4;山本 C4;やまもと

②sheet2にはその人の趣味が入っています。

A1;1  B1;釣り C1;つり
A2;空白 B2;踊り C2;おどり
A3;空白 B3;歌 C3;うた

A4;2  B4;読書 C4;どくしょ
A5;空白 B5;野球 C5;やきゅう


A6;3 B6;映画鑑賞 C6;えいがかんしょう

A7;4  B7;釣り C7;つり
A8;空白 B8;踊り C8;おどり
A9;空白 B9;歌 C9;うた

③sheet3を新に作成して

A1;1 B1;阿部 C1;あべ
A2;空白  B2;釣り C2;つり
A3;空白 B3;踊り C3;おどり
A4;空白 B4;歌 C4;うた
A5;空白 B5;阿部 C5;あべ

A6;2 B6;佐藤 C6;さとう
A7;空白 B7;読書 C7;どくしょ
A8;空白 B8;野球 C8;やきゅう
A9;空白 B9;佐藤 C9;さとう

A10;3 B10;山名 C10;やまな
A11;空白 B11;映画鑑賞 C11;えいがかんしょう
A12;空白 B12;山名 C12;やまな

A13;4 B13;山本 C13;やまもと
A14;空白  B14;釣り C14;つり
A15;空白 B15;踊り C15;おどり
A16;空白 B16;歌 C16;うた
A17;空白 B17;山本 C17;やまもと



のようにしたいです。

実際、データは、sheet1は419列、sheet2は2563列あります。

sheet1に氏名、sheet2にその氏名の人の趣味が入っています。

新たにsheet3を作成して、
氏名1
趣味
氏名1

氏名2
趣味
氏名2

氏名3
趣味
氏名3

氏名4
趣味
氏名4

としたいです。
VBAのコードを教えて下さい。

例えば
①sheet1には
A1;1 B1;阿部 C1;あべ
A2;2 B2;佐藤 C2;さとう
A3;3 B3;山名 C3;やまな
A4;4 B4;山本 C4;やまもと

②sheet2にはその人の趣味が入っています。

A1;1  B1;釣り C1;つり
A2;空白 B2;踊り C2;おどり
A3;空白 B3;歌 ...続きを読む

Aベストアンサー

こんばんは!

Sheet3にSheet1のデータを二度表示させるのがイマイチ理解できませんが、
ご質問通りにやってみました。

Sub Sample1()
Dim i As Long, lastRow As Long, myCnt As Long
Dim c As Range, wS1 As Worksheet, wS2 As Worksheet
Set wS1 = Worksheets("Sheet1")
Set wS2 = Worksheets("Sheet2")
Application.ScreenUpdating = False
wS2.Rows(1).Insert
wS2.Range("D:D").Insert
With Worksheets("Sheet3")
.Cells.ClearContents
lastRow = wS2.Cells(Rows.Count, "B").End(xlUp).Row
Range(wS2.Cells(2, "D"), wS2.Cells(lastRow, "D")).Formula = "=IF(A2="""",D1,A2)"
For i = 1 To wS1.Cells(Rows.Count, "A").End(xlUp).Row
With .Cells(Rows.Count, "B").End(xlUp).Offset(1)
.Value = wS1.Cells(i, "B")
.Offset(, -1) = wS1.Cells(i, "A")
.Offset(, 1) = wS1.Cells(i, "C")
End With
Set c = wS2.Range("A:A").Find(what:=wS1.Cells(i, "A"), LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
myCnt = WorksheetFunction.CountIf(wS2.Range("D:D"), wS1.Cells(i, "A"))
.Cells(Rows.Count, "B").End(xlUp).Offset(1).Resize(myCnt, 2).Value = _
c.Offset(, 1).Resize(myCnt, 2).Value
End If
'▼
.Cells(Rows.Count, "B").End(xlUp).Offset(1).Resize(, 2).Value = _
wS1.Cells(i, "B").Resize(, 2).Value
'▲
Next i
.Rows(1).Delete
wS2.Rows(1).Delete
wS2.Range("D:D").Delete
Application.ScreenUpdating = True
.Activate
End With
MsgBox "完了"
End Sub

※ コード内の▼から▲までがもう一度Sheet1のデータを表示させているコードです。
細かい検証はしていませんが、
こんな感じではどうでしょうか?m(_ _)m

こんばんは!

Sheet3にSheet1のデータを二度表示させるのがイマイチ理解できませんが、
ご質問通りにやってみました。

Sub Sample1()
Dim i As Long, lastRow As Long, myCnt As Long
Dim c As Range, wS1 As Worksheet, wS2 As Worksheet
Set wS1 = Worksheets("Sheet1")
Set wS2 = Worksheets("Sheet2")
Application.ScreenUpdating = False
wS2.Rows(1).Insert
wS2.Range("D:D").Insert
With Worksheets("Sheet3")
.Cells.ClearContents
lastRow = ...続きを読む

Q教えてGooの検索機能について

教えてgooには大変お世話になっております。

ふと気が向いたので、教えてGooの検索機能で
自分のIDを検索してみましたとところ、10何回質問をしているのに1件しかヒットしませんでした。
もちろん検索条件は”全カテゴリーから検索”です

これはどういうことでしょうか?

Aベストアンサー

検索はグーグルの方が使い易いです。
http://www.google.co.jp/search?hl=ja&q=tecutecu_2006&btnG=Google+%E6%A4%9C%E7%B4%A2&lr=lang_ja
http://kikitai.teacup.com/kotaeru.php3?q=2341616

Qsheet1(1月)からsheet12(12月)をsheet13(H17年度)に集計したい

sheet1(1月)
A   B  C
1 得意先  銀行  金額
2 aa社 xx 50
3 cc店 yy 30
4 ee社 xx 20

sheet2(2月)
  A B C
1 bb zz 50
2 ee xx 30
3 cc yy 50
4 dd ww 30

目的のsheet
sheet13(H17年度)
A     B    C    D
1 得意先  1月   2月   3月
2 aa社   50  
3 bb社 50
4 cc社 30 50
5 dd社 30
6 ee社 20 30

Aベストアンサー

元ファイルをシート分けせずに、月フィールドを作って整理し
ピポットテーブルを使えば一発です。

得意先銀行金額月
aaxx501月
ccyy301月
eexx201月
bbzz502月
eexx302月
ccyy502月
ddww302月

としておき、ピポットテーブルで
行:得意先、列:月、データ:合計/金額とすればよいでしょう


人気Q&Aランキング

おすすめ情報