あなたの映画力を試せる!POPLETA映画検定(無料) >>

あるフォルダにエクセルが10個あるとします。
フォルダを表示し、詳細の設定にすると、
エクセルそれぞれのサイズや更新日時などが一行ずつ表示されると思います。
ここに、最終保存者(最終更新者)を表示させたいです。
できますでしょうか?

A 回答 (3件)

サイズや更新日時が表示されているところ右クリックで表示内容を選択できたと思います。


そこになければありません。
    • good
    • 0

[作成者]は表示できますが、[最終保存者]はできません。


詳細にあるものはExcel独自のものを含む組み込みのドキュメント
プロパティの一部であって、エクスプローラーで確認ができるもの
ではないからです。

VBAを使いBuiltinDocumentPropertiesを取得して、Excelのシート
などに書き出すことは可能だと思いますので、それで対応するしか
ないと思います。
https://excel-ubara.com/excelvba4/EXCEL256.html
http://www.officetanaka.net/excel/vba/tips/tips1 …
    • good
    • 0

解答はすでに出ているようですが、これは、ファイルを開かないでプロパティを取る方法です。


https://support.microsoft.com/en-us/help/224351/ …

昔とコードが変わったので、掲示しておきます。MS-Wordも可能ですが、MS-Wordの場合は、一部、出にくいプロパティがありますので、テクニックが必要になります。

'Excel シートに出力
Sub GetAuthors()
 Dim DSO As Object 'New DSOFile.OleDocumentProperties
 Set DSO = CreateObject("DSOFile.OleDocumentProperties")
 Dim Files
 Dim fn
 Dim i As Long
 i = 2
 Files = Application.GetOpenFilename(FileFilter:="Excel Files(*.xls?),*.xls?", MultiSelect:=True)
 If VarType(Files) = vbBoolean Then Exit Sub
 Range("A1:C1").Value = Array("FileName", "更新者", "最終更新者")
 For Each fn In Files
  DSO.Open fn
  Cells(i, 1).Value = Dir(fn)
  Cells(i, 2).Value = DSO.SummaryProperties.Author
  Cells(i, 3).Value = DSO.SummaryProperties.LastSavedBy
  i = i + 1
 Next
End Sub
    • good
    • 0

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

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

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

Qエクセル 指定範囲をCSV出力

エクセル2016で
下記マクロで指定範囲をCSVで出力するようにしているのですが
名前を付けて保存の画面が表示されたときに
ファイル名の欄に作業中のファイル名が表示されません。
エクセル2010では表示されてたのですが2016ではできなくなりました。
修正案を教えていただけないでしょうか。
よろしくお願いいたします。

Sub CSV()
Dim myRng As Range, myFileName As String
Set myRng = Range("A:A,B:B,C:C")
If myRng Is Nothing Then Exit Sub
myFileName = Application.GetSaveAsFilename(FileFilter:="CSVファイル (*.csv,*.csv")
If myFileName = "False" Then Exit Sub
Application.ScreenUpdating = False
With Worksheets.Add
myRng.Copy .Cells(1, 1)
.Move
End With
With ActiveWorkbook
.SaveAs Filename:=myFileName, FileFormat:=xlCSV
.Close False
End With
Application.ScreenUpdating = True
Set myRng = Nothing
End Sub

エクセル2016で
下記マクロで指定範囲をCSVで出力するようにしているのですが
名前を付けて保存の画面が表示されたときに
ファイル名の欄に作業中のファイル名が表示されません。
エクセル2010では表示されてたのですが2016ではできなくなりました。
修正案を教えていただけないでしょうか。
よろしくお願いいたします。

Sub CSV()
Dim myRng As Range, myFileName As String
Set myRng = Range("A:A,B:B,C:C")
If myRng Is Nothing Then Exit Sub
myFileName = Application.GetSaveAsFilename(F...続きを読む

Aベストアンサー

>作業中のファイル名が表示されませんでした。
>エクセル2010では問題ないので、やはりバグなのでしょうか?
>また何かお気付きされましたら教えてください。

ここの掲示板で、Excel 2013以降で再現可能なバグらしきものに出会うことが増えているように思います。SDI(Single Document Interface) せいなのでしょうか。Excel 2010 は、なかなか手放すことができません。

・Application.Dialogs(xlDialogSaveAs).Show , 6
これで表示は出るにしても、古いダイアログでファイル名を単独では取得できないので、あまりお勧めできません。

No.3のコードで、以下の部分にブレークポイントをつけて、bkNameの変数がどうなっているか調べることはできますか?
もし、ご存知でしたら、以下は無視してください。

ブレークポイントは、VBA Editor の上部のデバックメニューか、または、左端の該当する行の枠の部分をワンクリックすると、●が付きます。それで実行すると、その部分で止まります。(添付画像)

myFileName = Application.GetSaveAsFilename(bkName, "CSVファイル (*.csv),*.csv")

そこで、ローカルウィンドウ(表示メニューの中)で、変数のbkNameが取れているかどうかを調べます。それで確認したら、「F8} を押し、実際のダイアログを出します。

変数で取得して も、ダイアログでファイル名が出ないとしたら、別案のFileDialogを提示します。前回のものを入れ替えてみました。(以下は、一部、拡張子を取る部分が無駄があります。また、Excel2016以外では試していませんので、.FilterIndex =16 の部分が、下位バージョンで変わるはずです)

'//
Sub SampleCSV2()
 Dim myRng As Range
 Dim myFileName As String
 Dim bkName As String, i As Long
 bkName = ActiveWorkbook.Name
 i = InStrRev(bkName, ".")
 If i > 0 Then
  bkName = Left(bkName, i - 1) '拡張子を取る
 End If
 Set myRng = Range("A:C")
 If Application.CountA(myRng) = 0 Then Exit Sub
 'Application.ScreenUpdating = False 'ないほうが良いかもしれない。
 With Worksheets.Add
  myRng.Copy
  .Cells(1, 1).PasteSpecial (xlPasteValues) 'ボタンオブジェクトをコピーしないようにする。
  .Move 'シートの移動
 End With
 Application.CutCopyMode = False 'コピーモードを終了
 '===========入れ替えしました=======
 With Application.FileDialog(msoFileDialogSaveAs)
  .InitialFileName = bkName
  .FilterIndex = 16 '"*.csv"
  If .Show = -1 Then
   myFileName = .SelectedItems(1)
  Else
   ActiveWorkbook.Close False '途中でやめた時、ブックを捨てる
   Exit Sub
  End If
 End With
 '===========
 With ActiveWorkbook
  On Error Resume Next 'ファイル名上書きをキャンセル等した時のため
  .SaveAs Filename:=myFileName, FileFormat:=xlCSV
  On Error GoTo 0
  .Close False
 End With
 'Application.ScreenUpdating = True
 Set myRng = Nothing
End Sub
'//

画像はデバッグの検査

>作業中のファイル名が表示されませんでした。
>エクセル2010では問題ないので、やはりバグなのでしょうか?
>また何かお気付きされましたら教えてください。

ここの掲示板で、Excel 2013以降で再現可能なバグらしきものに出会うことが増えているように思います。SDI(Single Document Interface) せいなのでしょうか。Excel 2010 は、なかなか手放すことができません。

・Application.Dialogs(xlDialogSaveAs).Show , 6
これで表示は出るにしても、古いダイアログでファイル名を単独では取得できないので、あま...続きを読む

Q日付の作成方法を教えて下さい。

縦カレンダーを作りたく、色々検索して月初日を作ることは出来ました。
そこから、+1してカレンダーを作りたいのですが上手く出来なかった為、質問させていただきました。


コード
Sub 日付作成()

Dim d As Date
d = Date ' 本日日付
Range("A2").Value = DateSerial(Year(d), Month(d), 1)

Dim tenkiws As Worksheet
Set tenkiws = Worksheets("転記先")

Dim i As Long
For i = 4 To 63 Step 2
tenkiws.Cells(i, 1) = tenkiws.Range("A2") + 1
Next i

End Sub

やりたいこととしては、一行飛ばしに日付を加算させていくなのですが、上のコードだと4行目だけ変わって後は変わりません。
どうすれば63行目まで変えることが出来るのでしょうか?
ご教授宜しくお願い致します。

縦カレンダーを作りたく、色々検索して月初日を作ることは出来ました。
そこから、+1してカレンダーを作りたいのですが上手く出来なかった為、質問させていただきました。


コード
Sub 日付作成()

Dim d As Date
d = Date ' 本日日付
Range("A2").Value = DateSerial(Year(d), Month(d), 1)

Dim tenkiws As Worksheet
Set tenkiws = Worksheets("転記先")

Dim i As Long
For i = 4 To 63 Step 2
tenkiws.Cells(i, 1) = tenkiws.Range("A2") + 1
N...続きを読む

Aベストアンサー

Sub 日付作成()

Dim d As Date
d = Date ' 本日日付
Range("A2").Value = DateSerial(Year(d), Month(d), 1)

Dim tenkiws As Worksheet
Set tenkiws = Worksheets("転記先")

Dim i As Long
For i = 4 To 63 Step 2
tenkiws.Cells(i, 1) = tenkiws.Range("A2") - 1 + i / 2
Next i

End Sub

QExcelで「令和」と表示されるのは5月1日にならないとだめですか?

「日本の新元号に関する Office の更新プログラム」というページ(下記)で、
「Windows と Office の更新プログラムを適用済みの場合でも、Windows 上で実行されている Office 製品は 2019 年 5 月 1 日に新元号が開始されるまで、新元号を表示しませんのでご注意ください。」
と書かれています。
https://support.microsoft.com/ja-jp/help/4478844/office-updates-for-new-japanese-era

今月4月中に、Excelのセルに来月5月以降の年月日を入力した場合に、自動で「令和」という元号を表示させることはできないのでしょうか。

もし、できるということであれば、「2019 年 5 月 1 日に新元号が開始されるまで、新元号を表示しません」とはどのような意味なのでしょうか。

Aベストアンサー

>こちらでは、「4月17日以降にOfficeも更新されれば「令和元年」と表示されると思います」と書かれているんですが

その方は、Microsoftの方ではないですし個人の予想ですよね?公式が出ているのにそれを持ち出してどうするんですか?

5/1より前に新しい元号を表示したい場合は数式や表示形式で限定的に表示させる方法を色々な方が考え付いていますよ。
検索すればたくさん出てきます。

Qエクセル2010 複数条件の平均値を出す関数について

介護事業所で事務をしております。
下記のことをしたいのですが、関数が判りません。

①写真のC25にB列の要支援1・要支援2の方の
 C列にある実績単位の平均値を計算式で出したい
②写真のC26にB列の要介護1・要介護2・要介護3・要介護4・要介護5の方の
 C列にある実績単位の平均値を計算式で出したい

AVERAGEIFSを使うと要支援1の方の平均値、要支援2の方の平均値などの
単一のグループの平均値は出せますが、
要支援1~2の方を合わせた全員の平均値や要介護1~5の方を合わせた全員の
平均値は出せません。

なにか良い方法があれば教えて頂けますでしょうか。
宜しくお願い致します。

Aベストアンサー

こんにちは!

要支援は「1」と「2」しかなく、要介護は「1」~「5」までという前提で・・・

画像の配置だとC25セルに
=SUMPRODUCT(ISNUMBER(FIND("支援",B4:B23))*C4:C23)/SUMPRODUCT(ISNUMBER(FIND("支援",B4:B23))*1)

C26セルに
=SUMPRODUCT(ISNUMBER(FIND("介護",B4:B23))*C4:C23)/SUMPRODUCT(ISNUMBER(FIND("介護",B4:B23))*1)

という数式を入れてみてください。

※ 「要支援」の方は
「支援」という文字が含まれているセルの合計 ÷ 「支援」のセル数

「要介護」も同じやり方です。m(_ _)m

Q特定の列範囲の中で最終列を指定

お世話になります。
以前質問した中で、別シートにデータを5列づつ
下に追加していくにはどうしたら良いかと言う質問をさせていただきました。

https://oshiete.goo.ne.jp/qa/11051972.html

上記回答で解決したのですが、
For j = 4 To .Cells(i, 1).End(xlToRight).Column Step unit
だと繰り返したくない列も動いてしまい、
繰り返す列範囲がD~W列のため
For j = 4 to 24 Step unit に変更しました。
すると今度は空白がある行も転記してしまい、困っています。

繰り返す範囲はD~W列まで5列毎に繰り返す
5列毎の最初のセルが空白か[0]であれば転記しない

どうぞよろしくお願いします。

Aベストアンサー

似ていますが、、、、

Sub Copies()
Const SRow = 3: Dim LRow As Long
Dim sht1 As Worksheet: Dim sht2 As Worksheet
Dim i As Long, j As Long, k As Long
Const UWide = 5
'===================
Set sht1 = Worksheets("Sheet1")
Set sht2 = Worksheets("Sheet2")
'===================
Application.ScreenUpdating = False
With sht1
LRow = .Cells(Rows.Count, 1).End(xlUp).Row
.Cells(SRow, 1).Resize(1, 3 + UWide).Copy sht2.Cells(1, 1)
k = 2
For i = SRow + 1 To LRow
For j = 4 To 23 Step UWide
If WorksheetFunction.CountA(.Cells(i, j).Resize(1, UWide)) > 0 Then
.Cells(i, 1).Resize(1, 3).Copy sht2.Cells(k, 1)
.Cells(i, j).Resize(1, UWide).Copy sht2.Cells(k, 4)
k = k + 1
End If
Next j
Next i
End With
Application.ScreenUpdating = True
End Sub

似ていますが、、、、

Sub Copies()
Const SRow = 3: Dim LRow As Long
Dim sht1 As Worksheet: Dim sht2 As Worksheet
Dim i As Long, j As Long, k As Long
Const UWide = 5
'===================
Set sht1 = Worksheets("Sheet1")
Set sht2 = Worksheets("Sheet2")
'===================
Application.ScreenUpdating = False
With sht1
LRow = .Cells(Rows.Count, 1).End(xlUp).Row
.Cells(SRow, 1).Resize(1, 3 + UWide).Copy sht2.Cells(1, 1)
k = 2
For i = SR...続きを読む

Qエクセルの関数について

例年この時期に必ず苦労して困っています。質問させてください…
毎年毎年、販売個数を出すのに列を削除する方がいて、ミスが起きたり作り直しとか大変でとても困ってます。

列を削除してもSUMproductの関数がつかいたいのですが、

=SUMPRODUCT($C$3:(ADDRESS(3,(MATCH("枚数"),0)-1),1),C4:(ADDRESS(3,(MATCH("枚数"),0)-1),4)))

みたいな感じで考えて見たのですがエラーメッセージでお手上げです…

どうにか個数と書いたの手前の行までの掛け算をする数式ができないでしょうか

よろしくお願いします!

Aベストアンサー

又 訂正です、

=SUMPRODUCT(INDIRECT("C3:"&ADDRESS(3,MATCH("枚数",INDIRECT("C3:Z3"),0)+2)))

何度も 申し訳ない、
こっちですね。


そして応用編が、
=SUMPRODUCT(INDIRECT("C3:"&ADDRESS(3,IFERROR(MATCH("枚数",INDIRECT("C3:Z3"),0),COUNTA(INDIRECT("C3:Z3")))+2)))

此方は、
もし "枚数"記載列をも、
削除してしまっても、

まあ 取り敢えずは、
エラーには ならない、
式です。


確認くださいね。


後、
解説を ご所望に、
なられる場合は、

そう、
お申し付けくださいね。


追記、
いゃ〜、
楽しませて 頂きました、

久々に、
頭が 回る、
噛み応えの ある、
課題でした、

いい課題を 有り難うです。

QExcelの関数について

A ・ B ・ C ・ D ・ E ・ F ・ G
1 ・鈴木 ・ 田中 ・ 太田 ・ 佐藤 ・ 石田 ・
2
3

上記のような表に"年休"と入力したら、G欄に入力した人の名前(1列目)をかえしたいのですが、

A ・ B ・ C ・ D ・ E ・ F ・ G
1 ・ 鈴木 ・ 田中 ・ 太田 ・ 佐藤 ・ 石田
2 ・ ・年休 ・ ・年休・ ・ 田中、佐藤
3 ・ 年休・ ・年休・年休・ ・ 鈴木、太田、佐藤

よろしくお願いします。

Aベストアンサー

[No.4]用の添付図です。

QCSVで文字化けしてしまうのを直すマクロ

いつもお世話になっております。
Excel2013を使用していますので
アドバイスどうぞよろしくお願いします。

"ファイル名"というシートのA列2行目からCSVファイルのファイル名が書いてあります。
日によるのですが、だいたい5~10件程度です。
そしてこのCSVファイルがくせ者でファイルを開くと文字化けを起こしてしまいます。下記のサイトを参考にマクロを作ったのですが、文字化けはしないものの文字に必ず""がついてしまい、また一行しか転記されません。

http://officetanaka.net/excel/vba/file/file10.htm

例 空白→""、 神奈川→"神奈川"

やりたいこととしてはファイル名とあるシートのA列2行目に書いてあるCSVファイルを開き、文字化けを直してSheet1にデータを表示させ、それをファイル名が書いてある最終行まで行いたいです。

Sub macro()
Dim i1 As Long, x As Long
Rbook As Workbook
Rsheet As Worksheet, Ssheet As Worksheet
Set Rbook = ThisWorkbook

Sheets("ファイル名").Select
Set Rsheet = Rbook.Worksheets("ファイル名")
For i1 = 2 To 10
If Rsheet.Cells(i1, 1).Value <> "" Then
Sheets("SHEET1").Select ’表示させるシート
Set Ssheet = Rbook.Worksheets("SHEET1")
Ssheet.Cells.Clear
Ssheet.Range("A1").Select

’文字化けを直す
Dim buf As String, Target As String, i1 As Long
Dim tmp As Variant, j As Long
Target = "¥アドレス" & Ssheet.Cells(i, 1).Value
With CreateObject("ADODB.Stream")
.Charset = "UTF-8"
.Open
.LoadFromFile Target
Do Until .EOS
buf = .ReadText(-2)
i = i + 1
tmp = Split(buf, ",")
For j = 0 To UBound(tmp)
Cells(i, j + 1) = tmp(j)
Next j
Loop
.Close
End With

’別のマクロ実行

End if
Next i1

’2行目、3行目と続く

End Sub

どうぞよろしくお願い致します。

いつもお世話になっております。
Excel2013を使用していますので
アドバイスどうぞよろしくお願いします。

"ファイル名"というシートのA列2行目からCSVファイルのファイル名が書いてあります。
日によるのですが、だいたい5~10件程度です。
そしてこのCSVファイルがくせ者でファイルを開くと文字化けを起こしてしまいます。下記のサイトを参考にマクロを作ったのですが、文字化けはしないものの文字に必ず""がついてしまい、また一行しか転記されません。

http://officetanaka.net/excel/vba/file/fil...続きを読む

Aベストアンサー

こんにちは。

>そのあと"buf = .ReadText(-2)"で止まり
>"パラメーターが間違っています"と表示されてしまいます。。。
>アドバイスどうぞよろしくお願いします。

ご指摘の部分は、残念ですが、想定外の問題で、ADODBを使って別のやり方はありますが、そのデータ自体の問題であり、原因は分からないままにコードを変えて何度も繰り返す可能性のほうが高いです。別のファイルでも、2番めに同じように起こりますか?

   Next j
  Loop
  .Close
 End With
 Set Strm = Nothing '←は入れたらどうでしょうか。
End Sub '←ここが最後の行

それと、私は、参照設定で、Adodb を入れていること。(Microsoft ActiveX Data Objects 2.8 Library)
Dim Strm As ADODB.Stream

これらは、あまり関係ないけれども、実際に自分がする時はこうします。もちろん、ご質問者さんが選んだ方法を完動するように書き上げただけですから、この延長上に、同様のエラーがなくなるという可能性は低いのではないかと思います。

今、思いついたのは、Excel 関数のClean 関数を間に入れる方法はあるとは思います。
それは、エラーを起こすと予想されるバイナリコードを除去する働きがあります。ただし、エラーがバイナリコードであれば、という条件です。

しかし、こちら側では、根本的な解決策は見当たりません。が、何度もトライするよりも、ダメだったファイルが、どうしてだめだったか、エディターなどで調べていただいたほうが良いですね。そちらのほうが早いのです。
巨大なファイルではない限りは、文字変換で、UTF-8 から、SJISに変換するツールで、一旦変更してから、インポートするほうが楽だと思います。Vector で、Unix系のツールなどいくつかあるようです。

こんにちは。

>そのあと"buf = .ReadText(-2)"で止まり
>"パラメーターが間違っています"と表示されてしまいます。。。
>アドバイスどうぞよろしくお願いします。

ご指摘の部分は、残念ですが、想定外の問題で、ADODBを使って別のやり方はありますが、そのデータ自体の問題であり、原因は分からないままにコードを変えて何度も繰り返す可能性のほうが高いです。別のファイルでも、2番めに同じように起こりますか?

   Next j
  Loop
  .Close
 End With
 Set Strm = Nothing '←は入れたらどうでし...続きを読む

Qエクセルのデータ抽出方法を教えてください

下記のような表から、A列のコードをもとにして「D」列の「3」行目の100、200、300(ピンク色)のセルを参照したいのですが関数がわかりません。
別のシートに10000なら100、20000なら200と表示させたいです。
vlookupでは行が1行でないとできませんでした。

Aベストアンサー

以下でいかがですか。
H2 =INDEX(E2:E13,MATCH(G2,A2:A13,0)+1)

Qエクセル リストと完全一致するセルに色をつける

シート1のA列とB列に
aaa ccc
bbb ggg
ccc kkk
ddd ooo
と言うリストがあって、A1〜A4はAチーム、B1〜B4まではBチームと名前を付けています
シート2にAチームのリスト4個が続いているものがあればセルを赤、Bチームのリスト4個が続いているものがあればセルを黄色に塗りたいです
AチームとBチームの中には同じ品番がある時もあります
条件付き書式で設定は出来るでしょうか?

Aベストアンサー

(´・ω・`)
”○” の数を数えるんじゃないんだよなあ。

・・・本題・・・

条件付き書式ですよね。

シート2のリストの並び順は
 aaa
 ccc
 bbb
 ddd
では「Aチーム」と認識しないという事でよろしいでしょうか?
ならば、とても簡単です。

シート2の一覧において、

 判定するセル1
 判定するセル2
 判定するセル3
 色を付けるセル
 判定するセル4
 判定するセル5
 判定するセル6

という範囲について調べれば良いという事。

 判定するセル1
 判定するセル2
 判定するセル3
 色を付けるセル

 判定するセル2
 判定するセル3
 色を付けるセル
 判定するセル4

 判定するセル3
 色を付けるセル
 判定するセル4
 判定するセル5

 色を付けるセル
 判定するセル4
 判定するセル5
 判定するセル6

の4パターンについてそれぞれ調べれば良いだけ。

自分なら
 aaa-bbb-ccc-ddd
のようにシート1から文字列を作り、それが調べるセルで同じパターンになるかを調べます。
シート1はA5セルから、シート2はA11セルからデータが入力されているなら、

 シート1!A5 & シート1!A6 & シート1!A7 & シート1!A8 = A11 & A12 & A13 & A14
 シート1!A5 & シート1!A6 & シート1!A7 & シート1!A8 = A12 & A13 & A14 & A15
 シート1!A5 & シート1!A6 & シート1!A7 & シート1!A8 = A13 & A14 & A15 & A16
 シート1!A5 & シート1!A6 & シート1!A7 & シート1!A8 = A14 & A15 & A16 & A17

という条件になる。
この4つのうちの一つでも条件を満たせばセルに赤色を付ければいい。
「Bチーム」についても同様にすればいいので、
この場合、8つの条件式を設定することになります。

面倒でもこの考え方ができていないと、ちょっと条件が変わっただけで対処できずに終わります。
冒頭で「並び順」について書きましたが、並び順がシート1のリストの通りでなくとも色を付けたい場合でも、この考え方は必要ということです。

・・・
ちなみに厄介なのが、どちらのチームにも「ccc」がいるというところかな。
これが無ければ違う方法でシンプルにできるんですけどねえ。

(´・ω・`)
”○” の数を数えるんじゃないんだよなあ。

・・・本題・・・

条件付き書式ですよね。

シート2のリストの並び順は
 aaa
 ccc
 bbb
 ddd
では「Aチーム」と認識しないという事でよろしいでしょうか?
ならば、とても簡単です。

シート2の一覧において、

 判定するセル1
 判定するセル2
 判定するセル3
 色を付けるセル
 判定するセル4
 判定するセル5
 判定するセル6

という範囲について調べれば良いという事。

 判定するセル1
 判定するセル2
 判定するセル3
 色を付け...続きを読む


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

人気Q&Aランキング