ID登録せずに、ニックネームで質問できる♪教えて!gooアプリ

エクセルのVBAであるフォルダ以下の全てのファイル名と更新時間をエクセルシート上に表示させたく、以下のプログラムを作成したのですが 、サブフォルダ内のファイルを表示させることができません。何か良い方法がありましたら教えていただけないでしょうか?宜しくお願いいたします。
Sub SAMPLE()
Dim serchPass As String
j = 1
Mypath = "C:\My Documents\"
MyName = Dir(Mypath, vbDirectory)
Do While MyName <> "" ' ループを開始します。
' 現在のフォルダと親フォルダは無視します。
If MyName <> "." And MyName <> ".." Then
' ビット単位の比較を行い、MyName がフォルダかどうかを調べます。
If (GetAttr(Mypath & MyName) And vbDirectory) = vbDirectory Then
Debug.Print MyName ' フォルダであれば、それを表示します。
Else: GoTo 10
End If

serchPass = Mypath & MyName
With Application.FileSearch
.NewSearch
.LookIn = serchPass
If .Execute() > 0 Then
For i = 1 To .FoundFiles.Count
Cells(i + j, 1).Value = .FoundFiles(i)
Cells(i + j, 3) = FileDateTime(.FoundFiles(i))
Next i
j = i + j
End If
End With
10
End If

   MyName = Dir ' 次のフォルダ名を返します。
Loop
End Sub

A 回答 (2件)

やりたい事は FileSearch で .SearchSubFolders = True にするのと違う事でしょうか?


Sub Test()
Dim i as Long
 With Application.FileSearch
  .NewSearch
  .LookIn = "C:\My Documents"
  .FileType = msoFileTypeAllFiles
  .SearchSubFolders = True
  If .Execute() > 0 Then
   For i = 1 To .FoundFiles.Count
    Cells(i + 1, 1) = .FoundFiles(i)
    Cells(i + 1, 3) = FileDateTime(.FoundFiles(i))
   Next i
  End If
 End With
End Sub
    • good
    • 0
この回答へのお礼

早速のご回答ありがとうございます。
これです。これ。
これをやりたくていろいろ調べて作ってみたのが、質問のところに載せたものです。全然短いプログラムで済んでしまうんですね。
ただ、インターネットのショートカットファイルで「プロシージャの呼び出し、または引数が不正です」となり、止まってしまいますが、これは直せないでしょうか?
宜しくお願いします。

お礼日時:2003/10/13 08:30

#1です。



ショートカットの場合 FileSearch の FoundFiles には、ショートカット先のパス(やURL)が返るようです。
ショートカットファイルそのものを取得する方法は知りません。

 For i = 1 To .FoundFiles.Count
  On Error Resume Next
  Cells(i + 1, 1) = .FoundFiles(i)
  Cells(i + 1, 3) = FileDateTime(.FoundFiles(i))
 Next i

のように逃げるとか。。

あと、私自信は使った事ないのですが、ファイルシステムオブジェクトを使うと FileSearch よりもっと高度な事が出来るようですよ。

http://www6.plala.or.jp/MilkHouse/practical/cont …

参考URL:http://www6.plala.or.jp/MilkHouse/practical/cont …
    • good
    • 0
この回答へのお礼

papayuka様、何度もすみません。
「On Error Resume Next」で逃げることにします。ファイルシステムオブジェクトについては今後勉強していこうと思います。
お世話になりました。ありがとうございました。

お礼日時:2003/10/13 16:52

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

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

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

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

QExcel VBA ファイル一覧とファイル作成日(更新日)を出力

Excel VBA ファイル一覧とファイル作成日(更新日)を出力
はじめまして
指定したフォルダのファイル名一覧の出力方法は、msn相談箱を参考にさせていただき、
再帰法を使ったやりかたで出力することができましたが、
同時にファイルの作成日を出力する方法を教えていただけないでしょうか。
よろしくお願いします。

Aベストアンサー

こんな感じでいかがでしょう?
投稿用にタブを全角スペースにしています。
Sheet1 の A1 セルに調べたいフォルダ名を入力して
標準モジュールに貼り付けて、マクロ makeFileList を実行してみてください。
Sheet2にリストがでるかと。
ところで、ここはカテゴリ違いですよ。

Sub makeFileList()
  Call fileList
  MsgBox "終了しました"
End Sub
  
Function fileList(Optional trgDir As String = "", Optional fCnt As Long = 0)
  On Error GoTo err
  Dim objFs As Object
  Dim objDir As Object
  Dim objFile As Object
  Dim i As Long
  
  Set objFs = CreateObject("Scripting.FileSystemObject")
  
  If trgDir = "" Then
    Set objDir = objFs.Getfolder(Sheets("sheet1").Range("a1"))
  Else
    Set objDir = objFs.Getfolder(trgDir)
  End If
  
  Set objFile = objDir.Files
    
  With Sheets("sheet2")
    For Each objFile In objDir.Files
        fCnt = fCnt + 1
        .Cells(fCnt, 1).Offset(1, 0) = fCnt
        .Cells(fCnt, 2).Offset(1, 0) = objFile.Path
        .Cells(fCnt, 3).Offset(1, 0) = objFile.DateCreated
        .Cells(fCnt, 4).Offset(1, 0) = objFile.DateLastModified
    Next objFile
    
    For Each objDir In objDir.SubFolders
      If objDir.Attributes <> 22 Then   'システムフォルダ除外
          
          '--------------サブフォルダの再帰検索
            Call fileList(objDir.Path, fCnt)
          '--------------サブフォルダの再帰検索
        
      End If
    Next objDir
  End With
  
  Set objFile = Nothing
  Set objDir = Nothing
  Set objFs = Nothing
Exit Function

err:
  Select Case err.Number
    Case 76 ' path がない
      MsgBox "path 指定が間違っています"
    Case Else
      MsgBox err.Number & vbCrLf & err.Description
  End Select
  
  Set objFile = Nothing
  Set objDir = Nothing
  Set objFs = Nothing
End Function

こんな感じでいかがでしょう?
投稿用にタブを全角スペースにしています。
Sheet1 の A1 セルに調べたいフォルダ名を入力して
標準モジュールに貼り付けて、マクロ makeFileList を実行してみてください。
Sheet2にリストがでるかと。
ところで、ここはカテゴリ違いですよ。

Sub makeFileList()
  Call fileList
  MsgBox "終了しました"
End Sub
  
Function fileList(Optional trgDir As String = "", Optional fCnt As Long = 0)
  On Error GoTo err
  Dim objFs As Object
  Dim objDir As Obje...続きを読む

QExcel VBA でサブフォルダ含むファイル名取得

勉強不足で申し訳ないですが、以下の処理をExcel VBAでやるにはどうしたらいいでしょうか?
仮に「C:\aaa」をルートフォルダとします。そのルートフォルダ下には「2008年」「2009年」など年の名前を付けたフォルダだけがあり、他に余計なファイル等はありません。そして、その「2008年」など年の名前のフォルダに、雑多なファイルが入っています。大雑把に図にすると、次のような感じです。

C:\aaa
├2008年
│ ├a1.pdf
│ └a2.pdf

└2009年
  ├b5.pdf
  └b6.pdf

そして、添付の図のように、A列には「2008年」などサブフォルダ名が、B列には「a1」などファイル名が出力されるようにしたいのです。なお、
(1)B列のファイル名の拡張子は、消えれば最高ですが、別に消えなくてもいいです。
(2)B列のファイル名をクリックするとファイルが開けるハイパーリンクがあると、嬉しいです。別になくてもいいです。

Aベストアンサー

Sub test()
Dim fso As FileSystemObject, fol As Folder, sfol As Folder, f As File
Dim ws As Worksheet
Dim rn As Range
Dim fn As String

Set fso = CreateObject("scripting.filesystemobject")
Set fol = fso.GetFolder(ThisWorkbook.Path)
Set ws = ActiveSheet
Set rn = ws.Cells(2, 1)
For Each sfol In fol.SubFolders
For Each f In sfol.Files
rn.Value = sfol.Name
fn = Left(f.Name, InStr(1, f.Name, ".") - 1)
ws.Hyperlinks.Add anchor:=rn.Offset(, 1), Address:=f.Path, TextToDisplay:=fn
Set rn = rn.Offset(1)
Next
Next

End Sub

参照設定で、Microsoft Scripting Runtimeを参照させてから実行してください。
アクティブシートのA2から、フォルダ名とファイル名・ハイパーリンク付を書き出します。
ただし、サブフォルダ内にフォルダがないことが前提です。

Sub test()
Dim fso As FileSystemObject, fol As Folder, sfol As Folder, f As File
Dim ws As Worksheet
Dim rn As Range
Dim fn As String

Set fso = CreateObject("scripting.filesystemobject")
Set fol = fso.GetFolder(ThisWorkbook.Path)
Set ws = ActiveSheet
Set rn = ws.Cells(2, 1)
For Each sfol In fol.SubFolders
For Each f In sfol.Files
rn.Value = sfol.Name
fn = Left(f.Name, InStr(1, f.Name, ".") - 1)
ws.Hyperlinks.Add anchor:=rn.Offset(, 1), Address:=f.Path...続きを読む

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

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

Aベストアンサー

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

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

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ベストアンサー

こんにちは。

こういうものですか?
開くフォルダを変えたいときは targ に与えるパスを変更します。

Sub OpenFolders()
Dim targ As String
targ = "C:\"
Shell "C:\Windows\Explorer.exe " & targ, vbNormalFocus
End Sub

QEXCEL VBAマクロ作成で、他のEXCELからデータを取り込みたい

メインプログラム(EXCEL VBA)より、
他のフォルダーにあるEXCELの項目の内容を取り込みたいです。
たとえば他のフォルダーのEXCELのRange("A2:A3").ValueをメインプログラムのRange("C2:C3").Valueにセットしたい時です。

・コマンドボタン押したら、どこのEXCELから取り込むかのポップアップ(?)は、表示はできてます。
・作業者が選んだパスとブックもMsgBoxで表示できてるので、もらう相手の場所も取得できてます。

・となると次はOPEN,INPUTですか?
テキストデータの取り込みですと、Inputでそのバッファを定義してるのですが、なんか違うような。。。

よろしくお願いします!

Aベストアンサー

私がやる方法です。

Dim writeSheet As Worksheet ' 自分自身の書き出し先シート
Set writeSheet = ThisWorkbook.Worksheets(1) ' Sheet1 を参照

Dim readBook As Workbook ' 相手ブック
Set readBook = Workbooks.Open(filename) ' 相手ブックを開いて参照
Dim readSheet As WorkSheet ' 相手シート
Set readSheet = readBook.Worksheets("sheetName") ' 相手シートを参照
' または Set readSheet = readBook.Worksheets(sheetIndex)

' 例えば
writeSheet.Cells(1, 1).Value = readSheet.Cells(2, 2).Value ' 相手シートの B2 の値を自分自身の A1 に書き込む

readBook.Close False ' 相手ブックを閉じる
Set readSheet = Nothing
Set readBook = Nothing

私がやる方法です。

Dim writeSheet As Worksheet ' 自分自身の書き出し先シート
Set writeSheet = ThisWorkbook.Worksheets(1) ' Sheet1 を参照

Dim readBook As Workbook ' 相手ブック
Set readBook = Workbooks.Open(filename) ' 相手ブックを開いて参照
Dim readSheet As WorkSheet ' 相手シート
Set readSheet = readBook.Worksheets("sheetName") ' 相手シートを参照
' または Set readSheet = readBook.Worksheets(sheetIndex)

' 例えば
writeSheet.Cells(1, 1).Value = readSheet.Ce...続きを読む

QExcelのマクロでファイル情報の取得方法(更新日付情報付)

現在Excelのマクロで
「指定フォルダの中のファイルで指定日より前のファイルを自動削除する」
マクロを作成中なのですが、現在指定ディレクトリ内のファイル情報の取得の部分で困っています。

・dir() ではファイル名は取れるが(私の調べた限りでは)日付情報が取れない
・shellでdirコマンドを発行しようとすると、ディレクトリがロングファイルネームでひっかかってしまい、そのままではエラーになる。
例【shell("command.com /c dir c:\Documents and Settings > 結果.txt")】

といった状態です。
最悪ロングファイルネームをすべてDOSルールに変換してshellコマンドで発行するテもあるかと思いますが、略時に同じ名前が重ならないか(mydocu~1で良いのかmydocu~2になるのか)等で管理が煩雑になりそうです。

マクロ上でファイル名と最終更新日付を取得できる方法がご存知の方がいらっしゃいましたら教えてください。
尚、指定ディレクトリ名の取得~削除の実行、ログの作成あたりは殆ど出来上がっています。

現在Excelのマクロで
「指定フォルダの中のファイルで指定日より前のファイルを自動削除する」
マクロを作成中なのですが、現在指定ディレクトリ内のファイル情報の取得の部分で困っています。

・dir() ではファイル名は取れるが(私の調べた限りでは)日付情報が取れない
・shellでdirコマンドを発行しようとすると、ディレクトリがロングファイルネームでひっかかってしまい、そのままではエラーになる。
例【shell("command.com /c dir c:\Documents and Settings > 結果.txt")】

といった状態で...続きを読む

Aベストアンサー

こんにちは。

OS は、9x 系? 2k 系?なのでしょうか?この前もここで書いたばかりですが、Excel2003 + XP SP2 の組み合わせでは、FileSearch オブジェクトが、問題なく使えるようです。

それから、VBAの中にFileDateTime関数が用意されてされていますから、そのまま使えます。


サンプル:設定期日より以下のファイルを格納する

Sub DirDateCheckPrc()
Dim MyPath As String
Dim myFName As String
Dim myDirs() As Variant
Dim ChkDate As Date
Dim i As Long
Const ENDLINE As Date = #8/1/2006# '設定期日

MyPath = ThisWorkbook.Path & "\" 'パスセパレータはこちらのキメウチです

 myFName = Dir(MyPath & "*.txt")
 Do While myFName <> ""
  ChkDate = CDate(FileDateTime(MyPath & myFName))
  If DateDiff("d", ChkDate, ENDLINE) > 0 Then
  ReDim Preserve myDirs(1, i)
  myDirs(0, i) = myFName
   '日付を格納する必要がなければ、配列変数は必要ないです。そのまま削除(Kill)等の処理してください。
  myDirs(1, i) = FileDateTime(MyPath & myFName)
  i = i + 1
  End If
  myFName = Dir()
 Loop
End Sub

こんにちは。

OS は、9x 系? 2k 系?なのでしょうか?この前もここで書いたばかりですが、Excel2003 + XP SP2 の組み合わせでは、FileSearch オブジェクトが、問題なく使えるようです。

それから、VBAの中にFileDateTime関数が用意されてされていますから、そのまま使えます。


サンプル:設定期日より以下のファイルを格納する

Sub DirDateCheckPrc()
Dim MyPath As String
Dim myFName As String
Dim myDirs() As Variant
Dim ChkDate As Date
Dim i As Long
Const ENDLINE As Date = #...続きを読む

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(VBA)で指定フォルダ内の最新ファイル名を取得したい

お世話になります。
指定フォルダ内に何種類か(xls,doc等)のファイルがあり、ファイル名はTitle毎としてあります。
タイトル毎の最新ファイル(TaitleAであれば03のファイル名を、TitleBであれば04)のファイル名を取得したいのですが、どうすれば良いか、詳しい方よろしくお願い致します。
(※当方バージョンは2003です。)
--------------------------------
(フォルダ内)
TitleA01.xls TitleB01.doc
TitleA02.xls TitleB02.doc
TitleA03.xls TitleB03.doc
       TitleB04.doc
--------------------------------

Aベストアンサー

こんにちは。

色々ありますが、この手の処理ではもっともベーシックな手法で、
Dir関数をループするやり方です。

ファイル名が「タイトル」から始まるファイルを、
拡張子は無視して、総当たりで検索して、
ファイル名を文字列値としての大小比較をすることで、簡単に、
一番大きな数字が付いたファイルを判別するように書いています。
簡単な記述であることを重視していますので、
 もしも、"TitleA2.xls"とか"TitleA02.xls"とか
 不規則な命名のファイルが混じっていると、
 "TitleA03.xls"よりも新しい、と判断される
ような書き方を選びましたので、注意してください。
実際の処理の場面でのお求めに対して、もしも不足があるようでしたら、
ご提示のファイル名について、どこまでが具体例なのか
判るような補足を書いてみて下さい。
例示が抽象的過ぎていたりすると、こちらからは、
お役に立てないものしか提示できないのかも知れませんので。


Sub Re8953548G()

Dim sDir As String
Dim sTitleHead As String
Dim sTemp As String
Dim sReturn As String

  ' ' 「指定フォルダ」へのパスをドライブ名から指定
  sDir = "D:\Work"
  ' ' ファイル名を前方一致で篩に掛ける「タイトル」を指定
  sTitleHead = "TitleA"

  ' ' Dir関数でファイル名を取得
  sTemp = Dir(sDir & "\" & sTitleHead & "*")
  ' ' Dir関数をループ
  Do While sTemp <> "" ' Dir関数でファイル名を取得し尽したらループ終了
  ' ' ファイル名が「タイトル」で始まるものだけ篩に掛ける
    If sTemp Like sTitleHead & "*" Then
      If sTemp > sReturn Then sReturn = sTemp
    End If
    sTemp = Dir() ' ' Dir関数で次のファイル名を取得
  Loop

  MsgBox "フォルダ:" & sDir & vbLf & "タイトル:" & sTitleHead & vbLf & "最新:" & sReturn

End Sub

こんにちは。

色々ありますが、この手の処理ではもっともベーシックな手法で、
Dir関数をループするやり方です。

ファイル名が「タイトル」から始まるファイルを、
拡張子は無視して、総当たりで検索して、
ファイル名を文字列値としての大小比較をすることで、簡単に、
一番大きな数字が付いたファイルを判別するように書いています。
簡単な記述であることを重視していますので、
 もしも、"TitleA2.xls"とか"TitleA02.xls"とか
 不規則な命名のファイルが混じっていると、
 "TitleA03.xls"...続きを読む

Qある範囲のセルから任意の値を検索して、その隣のセルの値を取得するという関数はありますか?

Excelの関数について質問します。
ある範囲のせるを検索して、その隣のセルの値を取得するという関数を探しています。
なければユーザー定義で作りたいと思っています。
VLOOKUP関数では一番左端が検索されますが、
それをある範囲まで拡張して、
その右隣の値を取得できるようにしたいのです。
どうかお知恵をお貸しください。

Aベストアンサー

●X1セルの値を範囲A1:F200の中から探して、その右隣のセルの値を返す

 =OFFSET(A1,SUMPRODUCT(ROW(A1:F200)*(A1:F200=X1))-1,SUMPRODUCT(COLUMN(A1:F200)*(A1:F200=X1)))

※最初のA1はワークシートの左上隅を示すものなので、検索範囲に関わらずA1固定
※SUMPRODUCT(ROW(A1:F200)*(A1:F200=X1)) ⇒ A1:F200で値がX1と一致するセルの行番号

>その「ある範囲」の中には検索したい値が入っているセルは1つしかありません。
というのが前提です。複数のセルがHITすると関係ないセルの値が返るので、
場合によっては、IFをかぶせてCOUNTIFで確認した方が良いかもしれません。
 ex. =IF(COUNTIF(A1:F200,X1)=1,【上記数式】,"えらー")

ちなみに、VBAでやるならこんな感じになるかと。

動作の概要
 【検査範囲】から【検査値】を探し、
 最初にHITしたセルについて、右隣のセルの値を返す。
 ex. =Sample(X1,A1:F200)

'--------------------------↓ココカラ↓--------------------------
Function Sample(ByVal 検査値 As Variant,ByVal 検査範囲 As Range)
 For Each セル In 検査範囲
  If セル = 検査値 Then Exit For
 Next セル
 Sample = セル.Offset(0, 1)
End Function
'--------------------------↑ココマデ↑--------------------------

いずれもExcel2003で動作確認済。
以上ご参考まで。

●X1セルの値を範囲A1:F200の中から探して、その右隣のセルの値を返す

 =OFFSET(A1,SUMPRODUCT(ROW(A1:F200)*(A1:F200=X1))-1,SUMPRODUCT(COLUMN(A1:F200)*(A1:F200=X1)))

※最初のA1はワークシートの左上隅を示すものなので、検索範囲に関わらずA1固定
※SUMPRODUCT(ROW(A1:F200)*(A1:F200=X1)) ⇒ A1:F200で値がX1と一致するセルの行番号

>その「ある範囲」の中には検索したい値が入っているセルは1つしかありません。
というのが前提です。複数のセルがHITすると関係ないセルの値が返るので、
場...続きを読む


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

人気Q&Aランキング