Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


1 / 3664 ページ 前へ→

【78898】Re:検索し、各シートを検索したセルを表...
回答[NEW]  ウッシ  - 17/2/21(火) 8:12 -

引用なし
パスワード
   こんにちは

こんな感じですか?

Sub サーチ()
  Dim i As Integer
  Dim DD As Date
  '##日付設定
  Sheets("Sheet2").Range("A1").FormulaR1C1 = "=TODAY()-1"
  Sheets("Sheet2").Range("A1").Value = Sheets("Sheet2").Range("A1").Value
  DD = Sheets("Sheet2").Range("A1").Value
  
  '##シートループ
  If ActiveWorkbook.Worksheets.Count < 1 Then Exit Sub
  For i = 1 To ActiveWorkbook.Worksheets.Count
    '###日付検索
    Dim Findcell As Range
    Set Findcell = Worksheets(i).Cells.Find(What:=DD, LookAt:=xlWhole, LookIn:=xlFormulas)
    '##無かったら
    If Not Findcell Is Nothing Then
      '##移動
      Application.Goto Findcell, True
      MsgBox "OK"
    End If
    
  Next i
End Sub

他の部分、出来てなかったんですね。
▼β さん:
>▼HARU さん:
>
>ところで、ほかのシートのセルの日付ですが、値で入っていますか?
>それとも、数式で入っているのでしょうか?
・ツリー全体表示

【78897】Re:検索し、各シートを検索したセルを表...
質問[NEW]  はる  - 17/2/21(火) 8:08 -

引用なし
パスワード
   ▼β さん:
>▼HARU さん:
>
>ところで、ほかのシートのセルの日付ですが、値で入っていますか?
>それとも、数式で入っているのでしょうか?

お手数おかけしております。
日付は値で入っております。
・ツリー全体表示

【78896】Re:検索し、各シートを検索したセルを表...
発言[NEW]  β  - 17/2/21(火) 7:03 -

引用なし
パスワード
   ▼HARU さん:

ところで、ほかのシートのセルの日付ですが、値で入っていますか?
それとも、数式で入っているのでしょうか?
・ツリー全体表示

【78895】Re:検索し、各シートを検索したセルを表...
発言[NEW]  β  - 17/2/21(火) 7:01 -

引用なし
パスワード
   ▼HARU さん:

書式を決めつけて LookIn を xlValues で検索することもできますが、
アップしたコードでは書式は何であっても取り出せるはずです。

調べてみますが今から夜まで外出しますので、レスは明日になるかと思います。
それまでにウッシさんや、他の回答者さんが対応していただけるかもしれませんね。
・ツリー全体表示

【78894】Re:検索し、各シートを検索したセルを表...
質問[NEW]  HARU  - 17/2/21(火) 6:07 -

引用なし
パスワード
   ▼β さん:
色々説明不十分で申し訳ありません。

sheet2はデータの何も入っていないsheetですので、スクロールはしてもしなくても問題ありません。シート数も増減するので全シートを対象にしていました。

ActiveBookは最終的にはマクロブック作成を念頭においております。
まずはThisBOOKで動作させたいと思っています。

>ポイントは以下かな?
>
>    If Not Findcell Is Nothing Then
>      On Error Resume Next
>      '##移動
>    Else
>      ActiveWindow.ScrollRow = Findcell
>    End If
>
>この On Error Resume Next 、これは何を意図して書かれたコードかわかりませんけど
>見つかった場合は On Error Resume Next ??
>見つからなかった場合は Else にいきますよね。
>見つからなかったのにスクロール?
> FindCell は Nothing ですからエラーになるのは当たり前なんですけど?

思い違いをしておりました・・・
IF FindCell が見つからなかったら、
On Error Resume Next
見つかってElseに飛んでサーチのつもりで書いていました


書いていただいたマクロ動かしてみましたが上手く表示されませんでした。
現在、日付の書式がmm"月"dd"日"(aaa)になっております。
書式を変更することも出来ますが、
書いていただいたコードはどの書式で対応しているのでしょうか
・ツリー全体表示

【78893】Re:検索し、各シートを検索したセルを表...
発言[NEW]  β  - 17/2/20(月) 23:40 -

引用なし
パスワード
   ▼はる さん:

コメントした通り、仕様と要件がいまいち不明ですが、もしかしてやりたかったことは
以下ですか?

Findメソッドで日付を検索する場合、日付のValue(つまり日付型の値)で、LookIn を
xlFormulas にすることがポイントです。

Sub Test()
  Dim DD As Date
  Dim Findcell As Range
  Dim sh As Worksheet
  
  DD = Date - 1
  
  For Each sh In Worksheets
    Set Findcell = sh.Cells.Find(What:=DD, LookAt:=xlWhole, LookIn:=xlFormulas)
    If Not Findcell Is Nothing Then Application.Goto Findcell.EntireRow.Cells(1), True
  Next
  
End Sub
・ツリー全体表示

【78892】Re:検索し、各シートを検索したセルを表...
発言[NEW]  β  - 17/2/20(月) 23:31 -

引用なし
パスワード
   ▼はる さん:

日付検索は、なかなかやっかいです。
用いる手法(今回の場合はFindメソッド)により、適切な検索方法をとる必要があります。

それ以外のコード記述にも問題が少なくありませんが、それ以前に、仕様が少し、あいまいです。

最初に SHeet2 の A1 に 昨日の日付を入れているわけですが、
その値を元にすべてのシートを処理してますね。
すべてですから、Sheet2 も対象で、つまり、Sheet2 なら、A1 が左上隅になるように
スクロールさせたい?
それとも Sheet2 は対象外?

関係するブックですけど、ActiveWorkbookが登場していますね。
これはマクロブックを意図しておられるのですか?
それとも、別のブックを意図しておられるのですか?

ポイントは以下かな?

    If Not Findcell Is Nothing Then
      On Error Resume Next
      '##移動
    Else
      ActiveWindow.ScrollRow = Findcell
    End If

この On Error Resume Next 、これは何を意図して書かれたコードかわかりませんけど
見つかった場合は On Error Resume Next ??
見つからなかった場合は Else にいきますよね。
見つからなかったのにスクロール?
FindCell は Nothing ですからエラーになるのは当たり前なんですけど?


>▼ウッシ さん:
>返信ありがとうございます。
>早速試してみましたが、
>
>上のコード
>実行時エラー5
>プロシージャの呼び出し、または引数が不正です。
>
>下のコード
>実行時エラー91
>オブジェクト変数またはWithブロック変数が設定されていません。
>
>と表示され動きませんでした。
>
>自分の書いたコードのIFが悪さをしているのかと外してみましたが変わらず・・・
>お助けくださいませ
・ツリー全体表示

【78891】Re:検索し、各シートを検索したセルを表...
質問[NEW]  はる  - 17/2/20(月) 22:46 -

引用なし
パスワード
   ▼ウッシ さん:
返信ありがとうございます。
早速試してみましたが、

上のコード
実行時エラー5
プロシージャの呼び出し、または引数が不正です。

下のコード
実行時エラー91
オブジェクト変数またはWithブロック変数が設定されていません。

と表示され動きませんでした。

自分の書いたコードのIFが悪さをしているのかと外してみましたが変わらず・・・
お助けくださいませ
・ツリー全体表示

【78890】Re:ファイルを更新順に読み込む方法
発言[NEW]  β  - 17/2/20(月) 21:22 -

引用なし
パスワード
   ▼もりC さん:

>objA.MoveFirstのところでコンパイルエラーが発生します。

こちらではコンパイルエラーはでませんが?
エクセルのバージョンは?

それはそれとして、別案。
フォルダ内のcsvファイルを最新更新日順に取り出すサンプルコードです。

Sub Test()
  Dim fPath As String
  Dim fName As String
  Dim sl As Object
  Dim k As String
  Dim i As Long
  
  Set sl = CreateObject("System.Collections.SortedList")
  fPath = ThisWorkbook.Path & "\"
  
  fName = Dir(fPath & "*.csv")
  
  Do While fName <> ""
    k = Format(FileDateTime(fPath & fName), "yyyymmddhhnnss") & " " & fName
    sl.Add k, fPath & fName
    fName = Dir()
  Loop
  
  For i = 0 To sl.Count - 1
    MsgBox sl.getbyindex(i)
  Next
  
End Sub
・ツリー全体表示

【78889】Re:ファイルを更新順に読み込む方法
質問[NEW]  もりC  - 17/2/20(月) 17:58 -

引用なし
パスワード
   ▼ウッシさん

ご回答ありがとうございます。
さっそく下記ソースを試しましたところ、
objA.MoveFirstのところでコンパイルエラーが発生します。
テストで準備したファイルに問題があるのでしょうか。
私自身知識不足なもので、見当違いな質問になっているかもしれません。
ご容赦くださいませ。

具体的に申しますと、処理の順としては、
a.csv
b.csv
c.csv



というファイルがあったとして、それぞれA列、B列にデータが入っています。
作られた日付の新しい順に、ファイル内A列から特定の文字を順に検索を掛け、
検索で引っかかった場所のB列を返すというマクロになります。


a.csv 読み込み
ファイル内検索
csv ファイルの1.列目(A列)検索 ヒットなし
a.csv ファイル閉じ

b.csv 読み込み
ファイル内検索
csv ファイルの1.列目(A列)検索 ヒットなし
b.csv ファイル閉じ

c.csv 読み込み
検索ヒット、2.列目(b列)情報取得
検索終わり

というようなプログラムを走らせたくて、
でも、日付順というのがわかりません。

一度に読み込み、別のシートにということも考えましたが、
ファイルの数が多くなると時間もかかると思われ、
何か良い方法はないものかと質問させていただきました。

またよい案がございましたら、ご教授お願いいたします。


▼ウッシ さん:
>こんにちは
>
>Sub test()
>  Dim objF  As Object
>  Dim objA  As Object
>  Dim fPath As String
>  Dim oFile As Object
>  
>  Set objF = CreateObject("Scripting.FileSystemObject")
>  Set objA = CreateObject("ADODB.Recordset")
>  objA.Fields.Append "FileName", 200, 300, 32 ', adVarChar, MaxCharacters, adFldIsNullable
>  objA.Fields.Append "ModifiedDate", 200, 300, 32
>  objA.Open
>  fPath = ThisWorkbook.Path
>  For Each oFile In objF.GetFolder(fPath).Files
>    If oFile Like "*.csv" Then
>      objA.AddNew
>      objA.Fields(0) = oFile
>      objA.Fields(1) = oFile.DateLastModified
>      objA.Update
>    End If
>  Next
>  objA.Sort = "ModifiedDate ASC" '昇順
>  objA.MoveFirst
>  Do Until objA.EOF
>    '処理Start
>    Debug.Print objA.Fields(1).Value & "----" & objA.Fields(0).Value
>    '処理End
>    objA.MoveNext
>  Loop
>  objA.Close
>  Set objA = Nothing
>  Set objF = Nothing
>End Sub
>
>一旦読み込ん並べて処理する感じです。
・ツリー全体表示

【78888】Re:ファイルを更新順に読み込む方法
回答[NEW]  ウッシ  - 17/2/20(月) 14:57 -

引用なし
パスワード
   こんにちは

Sub test()
  Dim objF  As Object
  Dim objA  As Object
  Dim fPath As String
  Dim oFile As Object
  
  Set objF = CreateObject("Scripting.FileSystemObject")
  Set objA = CreateObject("ADODB.Recordset")
  objA.Fields.Append "FileName", 200, 300, 32 ', adVarChar, MaxCharacters, adFldIsNullable
  objA.Fields.Append "ModifiedDate", 200, 300, 32
  objA.Open
  fPath = ThisWorkbook.Path
  For Each oFile In objF.GetFolder(fPath).Files
    If oFile Like "*.csv" Then
      objA.AddNew
      objA.Fields(0) = oFile
      objA.Fields(1) = oFile.DateLastModified
      objA.Update
    End If
  Next
  objA.Sort = "ModifiedDate ASC" '昇順
  objA.MoveFirst
  Do Until objA.EOF
    '処理Start
    Debug.Print objA.Fields(1).Value & "----" & objA.Fields(0).Value
    '処理End
    objA.MoveNext
  Loop
  objA.Close
  Set objA = Nothing
  Set objF = Nothing
End Sub

一旦読み込ん並べて処理する感じです。


▼もりC さん:
>特定のフォルダ内にある.csvファイルをファイルが更新した順に
>読み込んでいく方法がわかりません。
>
>ファイルを読むには
>   pathname = ThisWorkbook.Path
>   fname = Dir(pathname & "\*.csv", vbNormal)
>
>などと記述していましたが、これでは名前順でしか対応できません。
>
>どなたかよい方法をご存知でしたら、ご教授ください。
・ツリー全体表示

【78887】ファイルを更新順に読み込む方法
質問[NEW]  もりC  - 17/2/20(月) 13:32 -

引用なし
パスワード
   特定のフォルダ内にある.csvファイルをファイルが更新した順に
読み込んでいく方法がわかりません。

ファイルを読むには
   pathname = ThisWorkbook.Path
   fname = Dir(pathname & "\*.csv", vbNormal)

などと記述していましたが、これでは名前順でしか対応できません。

どなたかよい方法をご存知でしたら、ご教授ください。
・ツリー全体表示

【78886】Re:検索し、各シートを検索したセルを表...
回答[NEW]  ウッシ  - 17/2/20(月) 8:42 -

引用なし
パスワード
   追伸

コードの他の部分の動きは確認していません。
・ツリー全体表示

【78885】Re:検索し、各シートを検索したセルを表...
回答[NEW]  ウッシ  - 17/2/20(月) 8:40 -

引用なし
パスワード
   こんにちは

ActiveWindow.ScrollRow = Findcell



Application.GoTo Findcell, True



Application.GoTo Findcell.EntireRow.Cells(1, 1), True

とするとどうですか?


▼はる さん:
>書き込み失礼致します。ご指導よろしくお願いします。
>
>SHEET2に昨日の日付を入力し、他シートでその値で検索、スクロールしたいです。
>見よう見まねで書いてみましたが上手くスクロールしてくれません。
>どのように修正したらいいでしょうか。ご教授願います。
>
>
>Sub サーチ()
>'
>'
>'高速化
>'  Application.ScreenUpdating = False
>'  Application.DisplayAlerts = False
>
>'##日付設定
>  Sheets("Sheet2").Select
>  Range("A1").FormulaR1C1 = "=TODAY()-1"
>  Sheets("Sheet2").Range("A1").Value = Sheets("Sheet2").Range("A1").Value
>    
>'##シートループ
>  Dim i As Integer
>  Dim DD As String
>  DD = Range("A1").Value
>  If ActiveWorkbook.Worksheets.Count < 1 Then Exit Sub
>  For i = 1 To ActiveWorkbook.Worksheets.Count
>  Worksheets(i).Select
>  Range("A1").Select
> '###日付検索
>  Dim Findcell As Range
>  Set Findcell = Cells.Find(what:=DD)
>  '##無かったら
>  If Not Findcell Is Nothing Then
>  On Error Resume Next
>  '##移動
>  Else
>  ActiveWindow.ScrollRow = Findcell
>  End If
>  
>  Next i
>  
>'  Application.ScreenUpdating = true
>'  Application.DisplayAlerts = true
>  
>  '
>  End Sub
・ツリー全体表示

【78884】検索し、各シートを検索したセルを表示し...
質問[NEW]  はる  - 17/2/20(月) 2:03 -

引用なし
パスワード
   書き込み失礼致します。ご指導よろしくお願いします。

SHEET2に昨日の日付を入力し、他シートでその値で検索、スクロールしたいです。
見よう見まねで書いてみましたが上手くスクロールしてくれません。
どのように修正したらいいでしょうか。ご教授願います。


Sub サーチ()
'
'
'高速化
'  Application.ScreenUpdating = False
'  Application.DisplayAlerts = False

'##日付設定
  Sheets("Sheet2").Select
  Range("A1").FormulaR1C1 = "=TODAY()-1"
  Sheets("Sheet2").Range("A1").Value = Sheets("Sheet2").Range("A1").Value
    
'##シートループ
  Dim i As Integer
  Dim DD As String
  DD = Range("A1").Value
  If ActiveWorkbook.Worksheets.Count < 1 Then Exit Sub
  For i = 1 To ActiveWorkbook.Worksheets.Count
  Worksheets(i).Select
  Range("A1").Select
 '###日付検索
  Dim Findcell As Range
  Set Findcell = Cells.Find(what:=DD)
  '##無かったら
  If Not Findcell Is Nothing Then
  On Error Resume Next
  '##移動
  Else
  ActiveWindow.ScrollRow = Findcell
  End If
  
  Next i
  
'  Application.ScreenUpdating = true
'  Application.DisplayAlerts = true
  
  '
  End Sub
・ツリー全体表示

【78883】Re:vbcolor code
お礼  トキノハジメ  - 17/2/19(日) 14:47 -

引用なし
パスワード
   ▼β さん:
早速のご指導有難うございます。

今後とも宜しくお願い致します。
・ツリー全体表示

【78882】Re:vbcolor code
発言  β  - 17/2/19(日) 12:40 -

引用なし
パスワード
   ▼トキノハジメ さん:

vbHoge で規定されている色は以下の8色です。

黒(vbBlack)
白(vbWhite)
赤(vbRed)
明るい緑(vbGreen)
青(vbBlue)
黄(vbYellow)
ピンク(vbMagenta)
水色(vbCyan)

そのほかに、新しいエクセル(xl2007 ではどうかわかりませんが)

rgbHoge というものが144個指定可能です。
ただ、これらの中の 灰色関連が Gray と Grey というスペル両方でOKになっていますので
実際の数はそれより少ないですが。
(イギリス人でもアメリカ人でもスペルミスしないような配慮。我々は日本人なんですけどとMSに文句言いたいですが)

144個を列挙するのはスペースの関係でやめます。
以下を参照願います。

ht ps://msdn.microsoft.com/ja-jp/library/office/ff197459.aspx
・ツリー全体表示

【78881】Re:画像貼り付けについて
発言  β  - 17/2/19(日) 12:20 -

引用なし
パスワード
   ▼emiko2001 さん:

学校のほうにコメントを入れましたので参照願います。

なお、学校も質問箱も、マルチ許容ですが、それぞれの掲示板として、マルチの場合のルールがあります。

質問箱でいえば、画面の上のほうの こちら というバナーをクリックすると見ることができますし
学校の場合も、初めての方へ というページの中に マルチ に関する方針が記載されています。
・ツリー全体表示

【78880】画像貼り付けについて
質問  emiko2001 E-MAIL  - 17/2/19(日) 11:14 -

引用なし
パスワード
   複数のフォルダがあり、フォルダ内に入っている写真をEXCELに貼り付けて
フォルダごとに保存していくマクロを実行したいと考えています。

フォルダに入っている名前がバラバラの写真jpg(最大6枚)を自動で貼り付ける
マクロを組んでいて、セル【J27】【K27】【L27】【J39】【K39】【L39】に
貼り付けて保存したいと考えています。
色々と調べたりして作成しているのですがうまくいきません。
ご教授宜しくお願いします。
下記がコードです。


Dim fpath As String, fname As String, tname As String
Dim x As Long, y As Long

Application.ScreenUpdating = False
fpath = "C:\"             'CドライブのDフォルダ内
tmpath = fpath & "d\" & (j.Cells(i, 1).Value) & "\" ’セル名前と一致しているファルダ
fname = Dir(tmpath & "*.jpg", vbNormal)
tname = tmpath & fname
y = 10
x = 10

Do Until fname = ""

 If y < 13 Then
 
 s.Cells(27, y).Select
 With s.Pictures.Insert(tname)
.Left = Selection.Left
.Top = Selection.Top
.Width = Selection.Width
.Height = Selection.Height
 End With
 y = y + 1

Else
 
 s.Cells(39, x).Select
 With s.Pictures.Insert(tname)
.Left = Selection.Left
.Top = Selection.Top
.Width = Selection.Width
.Height = Selection.Height
  End With
 x = x + 1
 End If
 
 fname = Dir()
 
Loop

'Next x
 Application.ScreenUpdating = True

 w.SaveAs (p & "\E\" & j.Cells(i, 1).Value & ".xlsx") ’Eフォルダに名前をつけてxlsxで保存
 w.Close
Next i


宜しくお願いします。
・ツリー全体表示

【78879】vbcolor code
質問  トキノハジメ  - 17/2/19(日) 10:54 -

引用なし
パスワード
   いつもお世話になります。

VBColor コードを教えて下さい。

vbRed.vbGreen.vbRed等はわかりますが、橙色、茶色等、他にどんな色表記があるのか教えて下さい。
・ツリー全体表示

1 / 3664 ページ 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free