Excel VBA質問箱 IV

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

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


176 / 3841 ページ ←次へ | 前へ→

【78950】Re:フォルダ内ファイル複製
発言  γ  - 17/3/14(火) 20:28 -

引用なし
パスワード
   xcopyというコマンドの使用をお勧めします。
(/D オプションを使うとタイムスタンプの新旧を判定できます)

↓を参考にして下さい。
ht tp://www.k-tanaka.net/cmd/xcopy.php

どうしてもVBAだということなら、以下のようにすればよいでしょう。

Sub test()
  Dim s As String
  Dim v As Variant
  
  'D:\Aの中のファイルをD:\Bにコピーする例
  
  s = "xcopy "D:\A\* D:\B\ /D /Y" 
  v = Shell(s)
End Sub

フォルダ名にスペースを含む場合は、""で囲みます。
  s = "xcopy ""D:\201703\test A\*"" ""D:\201703\test B\"" /D /Y"
とします。

もちろんFileSystemObjectを使ってもできるだろうが、
簡単なことは簡単にすませたい。
・ツリー全体表示

【78949】Re:vlookup,index関数他について
発言  γ  - 17/3/14(火) 20:08 -

引用なし
パスワード
   こんにちは。
(1)内容について共通理解に立つため
(2)テスト検証に役立てるため
具体的なサンプルデータと、得たい結果を示してもらえますか?
そうすれば、コメントもつきやすいでしょう。
・ツリー全体表示

【78948】フォルダ内ファイル複製
質問  田中  - 17/3/14(火) 15:29 -

引用なし
パスワード
   基本的な質問で申し訳ないです。

EXCELVBA で フォルダ内のファイルを
別のフォルダへコピーすることは
できますでしょうか。

複製する際に、同じファイル名、タイムスタンプのものは
複製から除外できるようなものです。

現状、できるかどうかも分からないため、すみませんが、
ヒントだけでもお願いします
・ツリー全体表示

【78947】csvファイル内文字列検索
質問  kasper  - 17/3/14(火) 14:57 -

引用なし
パスワード
   初めまして、過去履歴など見させていただきましたが、
解決できなかったため、ファイル内の文字列検索についてご質問させてください。

特定のフォルダ(フォルダ内フォルダなし)に、複数csvファイルがあり、
コンマ区切りでデータが格納されています。
その中でたとえば、ファイルの2行目に文字列があり、1000行程度データ量があります。

特定の文字列を指定し、ファイルを順に検索をかけていき、
文字列を含むファイルを探したい場合に、処理速度を早くする方法はありませんか?

      Open filepass For Input As #1 'CSVファイルパス
      
      For u = 1 To 1000
      Line Input #1, LineData
      Data = Split(Data, ",") 'コンマ区切り


などで一行ずつ読み込みながらやっているのですが、時間がかかってしまします。

FileSystemObjectなどあるようですが、いまいち理解ができませんでした。

どなたか、ご教授のほどお願いします。
・ツリー全体表示

【78946】vlookup,index関数他について
質問  vba勉強中  - 17/3/14(火) 11:44 -

引用なし
パスワード
   いつもありがとうございます。簡単そうだと思って作っていたものが思いのほか複雑になってしまってわからなくなってしまいました。
タイトルはこれ使ったらいいのかな?というものを書いてみました。

やりたいことですが、シートA,Bがあります。
シートAはデータベース、シートBは挿入先となっていてBは複数のページに渡ります。
シートAの3列目には1,2,3,1,2,1,1,1,2,3,4,5,1,2,3,....と不規則に連続した自然数が並んでいて、[1]が現れるごとにシートBは次のページに進みます。自然数の最大値は1~99になります。

1,2,3,1,2,1,1,1,2,3,4,5,1,2,3,....(数列n)
(。)シートAの5列目には3パターンの文字列(K,L,M)があります。
(「)シートAの14列目には特定の文字列とその後に数字が含まれることがあります。
(数字の位置は不定です)
(」)シートAの15列目には5パターンの文字列があります。(a,b,c,d,e)(a<b<c<d<e)

(。)のKに関してはほとんど不要であるので、L,Mとa,b,c,d,eの計10パターンの挿入先が数列nの各項に対して存在します。ただしKであった場合は数列nは次項に進みます。

挿入先は毎ページ12列x行となっています。(7<x<20)
1~6列はLに対する、7~12列はMに対応しています。
1,7列目は数列nの各項が入っていきます。2~5,8~12列目にはほとんどの場合1が入りますが、(「)において数字が含まれる場合、その数字+1が入ります。

下に自分でできるだけやってみたものを示しますがもうぼろぼろです。この関数を使うと簡単等あれば教えていただければと思います。
相変わらずの説明下手、知識不足で申し訳ありませんがよろしくお願いします。


Sub maxtest()
  Dim n As Long, nrow As Long, ncol As Long, i As Long
  Dim target As Range, D3row As Long, D3col As Long
  Dim sh1 As Worksheet, D3 As Range, nexttarget As Range
  Dim cntA As Long, cntB As Long, cnt As Long
  Dim span As Range, srow As Long, scol As Long, nexts As Range
  Dim drrow As Long, drcol As Long
  Dim dzrow As Long, dzcol As Long
  Dim a As Long, b As Long

  
  Set sh1 = Worksheets("データベース")
  n = 1
  cnt = 1
  nrow = 5
  ncol = 3
  D3row = 8
  D3col = 29
  srow = 5
  scol = 2
  drrow = 10
  drcol = 7
  dzrow = 10
  dzcol = 1
  
  Set span = sh1.Cells(srow, scol)
  Set nexts = span.Offset(1)
  Set D3 = Cells(D3row, D3col)
  Set target = sh1.Cells(nrow, ncol)
  Set nexttarget = target.Offset(1)
  
  
  Do While Not IsEmpty(target)
    If target < nexttarget Then
      n = n + 1
      nrow = nrow + 1
    Else
      cntA = WorksheetFunction.CountIf(sh1.Range(sh1.Cells(nrow - n + 1, ncol), sh1.Cells _
      (nrow, ncol + 3)), "L")
      cntB = WorksheetFunction.CountIf(sh1.Range(sh1.Cells(nrow - n + 1, ncol), sh1.Cells _
      (nrow, ncol + 3)), "M")
      
      If cntA < 8 & cntB < 8 Then
        For i = 1 To n
          If target.Offset(cnt - n, 3) = "L" Then
            D3.Offset(drrow, drcol) = target.Offset(cnt - n)
              Select Case target.Offset(cnt - n, 12)
                Case "I"
                  D3.Offset(drrow, drcol + 1) = "1"
                Case "IIb"
                  If target.Offset(cnt - n, 11) Like "*" & "(他" & "*" & "箇所)" Then
                    a = InStr(target.Offset(cnt - n, 11), "(他")
                    b = InStr(target.Offset(cnt - n, 11), "箇所)")
                    D3.Offset(drrow, drcol + 2) = Mid(target.Offset(cnt - n, 11), a, b - a)
                  Else
                    D3.Offset(drrow, drcol + 2) = "1"
                  End If
                Case "IIa"
                  If target.Offset(cnt - n, 11) Like "*" & "(他" & "*" & "箇所)" Then
                    a = InStr(target.Offset(cnt - n, 11), "(他")
                    b = InStr(target.Offset(cnt - n, 11), "箇所)")
                    D3.Offset(drrow, drcol + 3) = Mid(target.Offset(cnt - n, 11), a, b - a)
                  Else
                    D3.Offset(drrow, drcol + 3) = "1"
                  End If
                Case "III"
                  If target.Offset(cnt - n, 11) Like "*" & "(他" & "*" & "箇所)" Then
                    a = InStr(target.Offset(cnt - n, 11), "(他")
                    b = InStr(target.Offset(cnt - n, 11), "箇所)")
                    D3.Offset(drrow, drcol + 4) = Mid(target.Offset(cnt - n, 11), a, b - a)
                  Else
                    D3.Offset(drrow, drcol + 4) = "1"
                  End If
                Case "IV"
                  If target.Offset(cnt - n, 11) Like "*" & "(他" & "*" & "箇所)" Then
                    a = InStr(target.Offset(cnt - n, 11), "(他")
                    b = InStr(target.Offset(cnt - n, 11), "箇所)")
                    D3.Offset(drrow, drcol + 5) = Mid(target.Offset(cnt - n, 11), a, b - a)
                  Else
                    D3.Offset(drrow, drcol + 5) = "1"
                  End If
                  
                cnt = cnt + 1
                drrow = drrow + 1
              End Select
          End If
          
          If target.Offset(cnt - n, 3) = "M" Then
            D3.Offset(dzrow, dzcol) = target.Offset(cnt - n)
              Select Case target.Offset(cnt - n, 12)
                Case "I"
                  D3.Offset(dzrow, dzcol + 1) = "1"
                Case "IIb"
                  If target.Offset(cnt - n, 11) Like "*" & "(他" & "*" & "箇所)" Then
                    a = InStr(target.Offset(cnt - n, 11), "(他")
                    b = InStr(target.Offset(cnt - n, 11), "箇所)")
                    D3.Offset(dzrow, dzcol + 2) = Mid(target.Offset(cnt - n, 11), a, b - a)
                  Else
                    D3.Offset(dzrow, dzcol + 2) = "1"
                  End If
                Case "IIa"
                  If target.Offset(cnt - n, 11) Like "*" & "(他" & "*" & "箇所)" Then
                    a = InStr(target.Offset(cnt - n, 11), "(他")
                    b = InStr(target.Offset(cnt - n, 11), "箇所)")
                    D3.Offset(dzrow, dzcol + 3) = Mid(target.Offset(cnt - n, 11), a, b - a)
                  Else
                    D3.Offset(drrow, dzcol + 3) = "1"
                  End If
                Case "III"
                  If target.Offset(cnt - n, 11) Like "*" & "(他" & "*" & "箇所)" Then
                    a = InStr(target.Offset(cnt - n, 11), "(他")
                    b = InStr(target.Offset(cnt - n, 11), "箇所)")
                    D3.Offset(dzrow, dzcol + 4) = Mid(target.Offset(cnt - n, 11), a, b - a)
                  Else
                    D3.Offset(dzrow, dzcol + 4) = "1"
                  End If
                Case "IV"
                  If target.Offset(cnt - n, 11) Like "*" & "(他" & "*" & "箇所)" Then
                    a = InStr(target.Offset(cnt - n, 11), "(他")
                    b = InStr(target.Offset(cnt - n, 11), "箇所)")
                    D3.Offset(dzrow, dzcol + 5) = Mid(target.Offset(cnt - n, 11), a, b - a)
                  Else
                    D3.Offset(dzrow, dzcol + 5) = "1"
                  End If
                  
                cnt = cnt + 1
                dzrow = dzrow + 1
              End Select
          End If
          srow = srow + 1
          Set span = sh1.Cells(srow, scol)
          Set nexts = span.Offset(1)
        Next
      End If
      
      D3row = D3row + 37
      cnt = 1
      n = 1
    End If
    nrow = nrow + 1
    Set target = sh1.Cells(nrow, ncol)
    Set nexttarget = target.Offset(1)
    Set span = sh1.Cells(srow, scol)
    Set nexts = span.Offset(1)
    Set D3 = Cells(D3row, D3col)
    
  Loop
End Sub
・ツリー全体表示

【78945】Re:OnKeyでAltを含むKeyを割り当てたい
回答  γ  - 17/3/14(火) 4:16 -

引用なし
パスワード
   動いている状態にする・・・?
sample1の処理は、
キーコンビネーションと動作の対応表を
変更する、一回限りの処理です。
この表に従って動作するのはExcel側の担当です。

このようなプロパティの変更処理は、
Bookを開いた時のイベントプロシージャに登録して
置くのが良いでしょう。閉じる時に元に戻す。

薄くて良いですから、VBAに関するテキストを購入して、
通読することをお勧めします。
基本となる話を発見し続けるのは非効率ですから。
・ツリー全体表示

【78944】Re:OnKeyでAltを含むKeyを割り当てたい
お礼  M.E  - 17/3/13(月) 23:05 -

引用なし
パスワード
   γ様

いつもご助言いただき、ありがとうございます。

>sample1を実行していないように読めるのですが。

意味を理解しました。
まず、sample1が動いている状態にしなければいけないのですね。
sample1を実行してからctrl+mを押したら、動きました。
(そりゃそうですよね。お恥ずかしい限りです。)

・・・と言うことは、エクセル起動と同時にsample1が動くように
設定する必要があるということですよね。

・・・まず、自分で調べてみます。

行き詰ったら、また質問させてください。

今後とも、よろしくお願い申し上げます。

M.E
・ツリー全体表示

【78943】Re:OnKeyでAltを含むKeyを割り当てたい
発言  γ  - 17/3/11(土) 18:01 -

引用なし
パスワード
   ▼M.E さん:
>γ様
>早速のご回答、ありがとうございます。
>アドバイスのごとく、コピーしてctrl+mを押してみたのですが、
>やはり、動きません。

sample1を実行していないように読めるのですが。
・ツリー全体表示

【78942】Re:OnKeyでAltを含むKeyを割り当てたい
お礼  M.E  - 17/3/11(土) 17:48 -

引用なし
パスワード
   γ様
早速のご回答、ありがとうございます。
アドバイスのごとく、コピーしてctrl+mを押してみたのですが、
やはり、動きません。

マクロの記述方法ではなく、別に問題があるようです。
月曜日に会社へ行って、会社のPCで試してみます。

いつもご助力いただき、ありがとうございます。

M.E
・ツリー全体表示

【78941】Re:OnKeyでAltを含むKeyを割り当てたい
発言  γ  - 17/3/11(土) 17:31 -

引用なし
パスワード
   標準モジュールに下記を貼り付け、
Sample1を実行してから、
Ctrl+m をやってみてください。
当方では正常に動作します。

Sub Sample1()
  Application.OnKey "^m", "Sample2"
End Sub

Sub sample2()
  MsgBox "OKですよ"
End Sub
・ツリー全体表示

【78940】Re:OnKeyでAltを含むKeyを割り当てたい
発言  M.E  - 17/3/11(土) 16:49 -

引用なし
パスワード
   γ様
いつも、アドバイスを頂き、ありがとうございます。
Sb Sample1()を以下へ書き換えて
ctrl mを試みてみてのですが、
やっぱり開きません。


Sub Sample1()

  Application.OnKey "^m", "Sample2"

End Sub


どこかで設定を変えるか何かが必要なのでしょうか・
そもそも、私の記述は、合っているのでしょうか?

お気づきの点等ございましたら、ご教示いただければ幸いに存じます。

M.E

以下でctrl+mの設定はできるのですが・・・
Excel「開発」タブ>「マクロ」メニュー>オプション
・ツリー全体表示

【78939】Re:OnKeyでAltを含むKeyを割り当てたい
発言  γ  - 17/3/11(土) 16:21 -

引用なし
パスワード
   ALT系はデフォルトが優先されるようですから
Ctrl系を使ってみてはどうですか?
・ツリー全体表示

【78938】OnKeyでAltを含むKeyを割り当てたい
質問  M.E  - 17/3/11(土) 15:05 -

引用なし
パスワード
   お世話になっております。
78931:セル内の文字の一部の色を変えたい
の質問をさせていただきました、M.Eです。

アドバイスを頂いたおかげで、何とかマクロを組むことが出来ました。

Sub Sample2()

・いずれかのセルにAABBCCDDAABBCCDDAABBCCDDが入力されているとします。
・マクロを実行するとInPut Boxが表示されます。
・例えばCDと入力します。
・AABBCCDDAABBCCDDAABBCCDDのCDの3か所を赤色に変えることが出来ました。

ご助力、ありがとうございました。

ここからが質問なのですが、

このSub Sample2()をショートカットキー:Altとfで呼び出せるようにしたく、
手前にSub Sample1()のマクロを付け加えました。

ところが、これを押すと、"情報"の画面に飛んでしまいます。
また、根本的な勘違いやおかしなことをしているのではないかと思い
投稿させていただきました。

いつもながら恐縮ですが、
ご助言・ご助力を承れれば幸いに存じます。

よろしくお願い申し上げます。


Sub Sample1()

  Application.OnKey "%{f}", "Sample2"

End Sub


Sub Sample2()


Dim buf As String, msg As String
Dim start As Integer


  msg = "配列を入力してください。"
  buf = InputBox(msg)
  If buf = "" Then
  Exit Sub
  End If
  
  
  start = 1

  
  While InStr(start, ActiveCell, buf) >= 1
  
    start = InStr(start, ActiveCell, buf)
    ActiveCell.Characters(start, Len(buf)).Font.ColorIndex = 3
    start = start + Len(buf)
  
  Wend
・ツリー全体表示

【78937】Re:webページとして保存とハイパーリンク...
発言  亀マスター  - 17/3/11(土) 0:42 -

引用なし
パスワード
   同じ環境が用意できないので確証は持てないのですが、
アドレスの中に#が入ってるのが原因だったりしないでしょうか。
私も自分で作った簡易システムで似たような経験があります。
違ったら済みません。
・ツリー全体表示

【78936】webページとして保存とハイパーリンクに...
質問  xkxft011  - 17/3/8(水) 18:16 -

引用なし
パスワード
   次のようなハイパーリンクについて、
通常のEXCEL保存から行う場合には、
ファイル名 データ001.xlsx
シート名 電子証明書
セル A1

を起動することができます。

=HYPERLINK(\\***.***.**.***\share\Reference Data\データ001.xlsx#電子証明書!A1 , F2)


しかし、このEXCELファイルを、Webページで保存して、
クロームのブラウザから行う場合には、
シート名 電子証明書

ファイル名 データ001.xlsx  は、起動することができますが、
セル A1   に到達することはできません。


どのような対処法が可能であるか、ご教示ください。
・ツリー全体表示

【78935】Re:セル内の文字の一部の色を変えたい
お礼  M.E  - 17/3/6(月) 7:19 -

引用なし
パスワード
   早速のご返答、ありがとうございます。
恥ずかしながら、関数で書式が変えられないことを知りませんでした。
大変勉強になります。

β様のアドバイスやγ様のコードを基に、
試行錯誤してみようと思います。

途中、どうにも行き詰ってしまったら
また、投稿させてください。

今後とも、どうぞよろしくお願い申し上げます。

M.E
・ツリー全体表示

【78934】Re:セル内の文字の一部の色を変えたい
発言  γ  - 17/3/5(日) 22:00 -

引用なし
パスワード
   まずは、特定の文字の色を変更する動作を
「マクロ記録」してみてください。

それを元にして
繰り返し処理を考慮して、下記のようなコードを作ってみました。
部品として研究してみて下さい。

Sub test()
  Dim s As String
  Dim t As String
  Dim k As Long
  
  s = Range("A1").Value
  t = Range("B1").Value
  k = InStr(s, t)
  Do While k > 0
     Range("A1").Characters(Start:=k, Length:=Len(t)).Font.Color = RGB(255, 0, 0)
    k = InStr(k + Len(t), s, t)
  Loop
End Sub
・ツリー全体表示

【78933】Re:セル内の文字の一部の色を変えたい
発言  β  - 17/3/5(日) 21:26 -

引用なし
パスワード
   ▼M.E さん:

基本的なことですけど、通常数式であれユーザー定義関数(UDF)であれ

★書式の設定はできません。

したがって、M.Eさんの構想は、残念ながらNGとなります。

やるとすれば、UDFといったものではなく、たとえばシートのChangeイベントで
A1 ないしは B1 に値が入った時に、自動的に、この処理を実行するといったことが
考えられます。
・ツリー全体表示

【78932】Re:セル内の文字の一部の色を変えたい
発言  γ  - 17/3/5(日) 21:25 -

引用なし
パスワード
   ユーザー定義関数で書式を変更することはできません。
ボタンにマクロを登録して、Activecellにそういう変更を加えることは可能です。
そういうことでよいでしょうか?
・ツリー全体表示

【78931】セル内の文字の一部の色を変えたい
質問  M.E  - 17/3/5(日) 21:00 -

引用なし
パスワード
   いつもお世話になっております。
また、質問させてください。

例えば
A1に「AAABBBCCCAAABBBCCC」という文字が入っていたとします。
B1に「BC」という文字を入力したとします。
Functionプロシージャでユーザー関数を作成し
B1で指定した文字がA1に存在するとき
その部分(A1内のBCの部分(2箇所))を赤色に変えたい。

ヒントだけでも結構ですので、ご教示いただければ幸いに存じます。

よろしくお願い申し上げます。

M.E
・ツリー全体表示

176 / 3841 ページ ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free