Excel VBA質問箱 IV

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

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


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

【81766】8桁数字(YYYYMMDD)の年月日の間に/スラ...
質問  V  - 21/4/28(水) 20:50 -

引用なし
パスワード
   はじめまして。ダウンロードデータの日付情報が8桁の数字(例:20210428)になっているのですが、年月日の間にスラッシュ/をいれて、2021/04/28 という文字列に変換し、その列の最後のデータまで繰り返したいのです。どなたかご教授ください!
・ツリー全体表示

【81765】Re:昨日以前の日付→明日へ変更する処理
回答  しん  - 21/4/28(水) 15:24 -

引用なし
パスワード
   こんな感じ

Sub tes01()
Dim tRng As Range
Dim R As Integer, endRow As Integer
'日付の最初のセル
Set tRng = Range("A3")
'下に続くセル数
endRow = tRng.End(xlDown).Row - tRng.Row
For R = 0 To endRow
 If tRng.Offset(R, 0).Value <= Date Then 'セルの日付が今日以前の場合
  tRng.Offset(R, 0).Value = Date + 1   'セルの明日の日付にする
 End If
Next

End Sub
・ツリー全体表示

【81764】Re:昨日以前の日付→明日へ変更する処理
回答  山内  - 21/4/28(水) 13:59 -

引用なし
パスワード
   Worksheet_Chageイベントでできると思います
Targetの値と今日の日付を比較して値を書き換えるだけですね
・ツリー全体表示

【81763】Re:シート内のすべてのピボットテーブル...
お礼  やまと  - 21/4/28(水) 12:00 -

引用なし
パスワード
   まなさん

解決しました!本当にありがとうございます!
・ツリー全体表示

【81762】昨日以前の日付→明日へ変更する処理
質問  やまと  - 21/4/28(水) 11:58 -

引用なし
パスワード
   質問失礼いたします。


列1
2021/05/30
2021/06/05
2021/04/05 → 2021/04/28

というように、過去分の日付列に入力されていたら、その日付を自動的に明日へ書き換えるという処理のVBAを記述したいです。

当方初心者のため、何卒ご指南いただけると幸いです。
・ツリー全体表示

【81761】Re:複数シートからルビ付きのデータをコ...
お礼  あたる  - 21/4/25(日) 17:42 -

引用なし
パスワード
   作ってみたら動かすことができました。
大変助かりました。
ありがとうございました!

▼通りすがり さん:
>VBA シート ループ
>で検索してみてください。
・ツリー全体表示

【81760】Re:複数シートからルビ付きのデータをコ...
お礼  あたる  - 21/4/25(日) 15:55 -

引用なし
パスワード
   ありがとうございます!
さっそく試してみます。
・ツリー全体表示

【81759】Re:複数シートからルビ付きのデータをコ...
発言  通りすがり  - 21/4/25(日) 15:47 -

引用なし
パスワード
   セルのコピペでルビをコピーする方法がありますが、

GetPhonetic
SetPhonrtic
でルビの取得、ルビの設定ができます。

参考HPです。

ht tps://excel-ubara.com/excelvba1/EXCELVBA404.html
・ツリー全体表示

【81758】Re:行のを削除・行の挿入について
発言  γ  - 21/4/25(日) 15:37 -

引用なし
パスワード
   ちょっとお尋ねするが、
修正版のコードは、
例えば、A1セルに値を入力するだけでも対象となって取消が行われますよ。
それは、されたいことだったんですか?

当然ながら、一行全体に1を入力しても
(これは行を挿入しているわけではない)、
取消の対象になりますよ。

まあ、されたいことと違ったとしても、満足されているなら、
"それも一局"かも知れませんが。
・ツリー全体表示

【81757】Re:複数シートからルビ付きのデータをコ...
発言  通りすがり  - 21/4/25(日) 15:23 -

引用なし
パスワード
   VBA シート ループ
で検索してみてください。
・ツリー全体表示

【81756】Re:複数シートからルビ付きのデータをコ...
発言  あたる  - 21/4/25(日) 14:59 -

引用なし
パスワード
   返信ありがとうございます。
自動記録を使い、シートが三つの場合をとりあえず試しました。そのコードの意味は分かるのですが、複数のシートからコピペするプログラムの作り方がわかりません。お手上げ状態です。汗&#128167;

▼通りすがり さん:
>ある程度はマクロの自動記録で参考コードが得られると思いますが、
>どこまでコードが出来てますか?
・ツリー全体表示

【81755】Re:複数シートからルビ付きのデータをコ...
発言  通りすがり  - 21/4/25(日) 14:43 -

引用なし
パスワード
   ある程度はマクロの自動記録で参考コードが得られると思いますが、
どこまでコードが出来てますか?
・ツリー全体表示

【81754】複数シートからルビ付きのデータをコピペ
質問  あたる E-MAIL  - 21/4/25(日) 14:29 -

引用なし
パスワード
   大変困っております。
なにとぞお力添えをお願い致します。

【最初の状態】
1.複数のシートがある。(枚数不明)
2.シートのA1とA2とA3にルビ付きの漢字がある。
【やりたいこと】
1.すべてのシートに対して、A1とA2とA3の漢字をコピーする。
2.貼り付け用のシートを作る。
3.ペーストする際は縦と横を入れ替えてルビ付きのままとする。

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

【81753】Re:行のを削除・行の挿入について
お礼  TDS  - 21/4/25(日) 13:58 -

引用なし
パスワード
   ▼γ さん:
>1行目から66行目までに「名前定義」をしておき(例:下記test)、
>これを利用して、その範囲の行の挿入・削除が行われたら、その動作を元に戻します。
>
><<シートモジュール>>
>Private Sub Worksheet_Change(ByVal Target As Range)
>  If Intersect(Target, Rows("1:66")) Is Nothing Then Exit Sub
>  If Range("myRange").Rows.Count <> 66 Then
>    Application.EnableEvents = False
>    Application.Undo
>    Application.EnableEvents = True
>  End If
>End Sub
># Application.EnableEventsを操作しているのは、
># Undoによって再度Changeイベントプロシージャが
># 呼ばれることを回避するため。
>
>(*)標準モジュールで一度だけ実行します。(もちろん手作業でも可)
>Sub test()
>  ActiveWorkbook.Names.Add Name:="myRange", RefersToR1C1:="=Sheet1!R1:R66"
>End Su

γ さん、やりたかったことができました。
少し手直しして行の削除と行の挿入ができました。ありがとうございますm(__)m

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim ctr As Integer
  Dim ctc As Integer
  Dim mystr As String
  Dim myrange As Range

  'オブジェクト変数 myrange にセル範囲を放り込みます
  Set myrange = Target.CurrentRegion

  'セル範囲の行数と列数を数えます
  ctr = myrange.Rows.Count
  ctc = myrange.Columns.Count
  
  If Intersect(Target, Rows("1:66")) Is Nothing Then Exit Sub
  If ctr < 66 Then
    Application.EnableEvents = False
    Application.Undo
    Application.EnableEvents = True
  End If
  
End Sub
・ツリー全体表示

【81752】Re:行のを削除・行の挿入について
お礼  TDS  - 21/4/25(日) 13:55 -

引用なし
パスワード
   ▼sinzo さん:
>検証願います。
>
>Option Explicit
>Dim ListCnt
>
>Private Sub Worksheet_Change(ByVal Target As Range)
>Dim c
>Dim Rng, Rng2
>
>Set Rng = ActiveCell
>Set Rng2 = Intersect(Rng, Range("1:16"))
>
>If Rng2 Is Nothing Then Exit Sub
>  Set c = CommandBars("Standard").Controls(14)
>  If ListCnt < c.ListCount Then  '履歴がふえたら
>    If c.TooltipText = "元に戻す(&U) クリア (Ctrl+Z)" Then
>      MsgBox "クリアをキャンセルします。"
>      Application.Undo
>    End If
>  End If
>  ListCnt = c.ListCount
>
>End Sub

sinzo さんご回答ありがとうございます。
行の削除・行の挿入でなっかったですが、
入力欄の削除などできないようにするようですが、勉強になりました。
ありがとうございますm(__)m
・ツリー全体表示

【81751】Re:行のを削除・行の挿入について
回答  γ  - 21/4/25(日) 7:41 -

引用なし
パスワード
   1行目から66行目までに「名前定義」をしておき(例:下記test)、
これを利用して、その範囲の行の挿入・削除が行われたら、その動作を元に戻します。

<<シートモジュール>>
Private Sub Worksheet_Change(ByVal Target As Range)
  If Intersect(Target, Rows("1:66")) Is Nothing Then Exit Sub
  If Range("myRange").Rows.Count <> 66 Then
    Application.EnableEvents = False
    Application.Undo
    Application.EnableEvents = True
  End If
End Sub
# Application.EnableEventsを操作しているのは、
# Undoによって再度Changeイベントプロシージャが
# 呼ばれることを回避するため。

(*)標準モジュールで一度だけ実行します。(もちろん手作業でも可)
Sub test()
  ActiveWorkbook.Names.Add Name:="myRange", RefersToR1C1:="=Sheet1!R1:R66"
End Su
・ツリー全体表示

【81750】Re:行のを削除・行の挿入について
回答  sinzo  - 21/4/24(土) 22:39 -

引用なし
パスワード
   検証願います。

Option Explicit
Dim ListCnt

Private Sub Worksheet_Change(ByVal Target As Range)
Dim c
Dim Rng, Rng2

Set Rng = ActiveCell
Set Rng2 = Intersect(Rng, Range("1:16"))

If Rng2 Is Nothing Then Exit Sub
  Set c = CommandBars("Standard").Controls(14)
  If ListCnt < c.ListCount Then  '履歴がふえたら
    If c.TooltipText = "元に戻す(&U) クリア (Ctrl+Z)" Then
      MsgBox "クリアをキャンセルします。"
      Application.Undo
    End If
  End If
  ListCnt = c.ListCount

End Sub
・ツリー全体表示

【81749】Re:選択しているセルの一部に文字をいれる
発言  通りすがり  - 21/4/24(土) 21:56 -

引用なし
パスワード
   お遊びコードです。
セル範囲をドラッグで選択して試してみてください。

ドラッグの方向によってstartとgoalのセルが違ってきます。
ドラッグ開始セルのアドレス情報を使用しています。

Sub test()
Dim sel As Range
Dim tl As Range
Dim tr As Range
Dim bl As Range
Dim br As Range
Dim startcell As Range
Dim goalcell As Range
 Set sel = Selection
 Set tl = sel.Resize(1, 1)
 Set tr = tl.Offset(, sel.Columns.Count - 1)
 Set bl = tl.Offset(sel.Rows.Count - 1)
 Set br = tl.Offset(sel.Rows.Count - 1, sel.Columns.Count - 1)
 'MsgBox "tl:" & tl.Address & vbCrLf & "tr:" & tr.Address & vbCrLf & "bl:" & bl.Address & vbCrLf & "br:" & br.Address
 Select Case ActiveCell.Address
  Case tl.Address
  Set startcell = tl
  Set goalcell = br
  Case br.Address
  Set startcell = br
  Set goalcell = tl
  Case bl.Address
  Set startcell = bl
  Set goalcell = tr
  Case tr.Address
  Set startcell = tr
  Set goalcell = bl
  End Select
  If startcell.Address = goalcell.Address Then
   startcell.Value = "s/g"
  Else
   startcell.Value = "start"
   goalcell.Value = "goal"
  End If
  Set tl = Nothing
  Set tr = Nothing
  Set bl = Nothing
  Set br = Nothing
  Set startcell = Nothing
  Set goalcell = Nothing
  Set sel = Nothing
End Sub
・ツリー全体表示

【81748】Re:フォルダ内のデータを指定フォルダに...
回答  γ  - 21/4/23(金) 20:22 -

引用なし
パスワード
   ht tp://officetanaka.net/excel/vba/filesystemobject/filesystemobject03.htm
こちらを参考にしてみてはどうでしょう。(3文字目のスペースは取ってください)

ワイルドカードを使えますので、
FSO.CopyFile "C:\Tmp\*.PDF", "C:\Work\"
のようにしてみてはどうでしょう。
・ツリー全体表示

【81747】Re:行のを削除・行の挿入について
お礼  TDS  - 21/4/23(金) 18:56 -

引用なし
パスワード
   ▼山内 さん:
>適当ですがA66が押し出されてA67に値が入ったら戻るを実行します
>
>Private Sub Worksheet_Change(ByVal Target As Range)
>  If Range("A67").Value <> "" Then
>    Application.Undo
>  End If
>End Sub

1行の削除と挿入に有効ですね。
複数行まもめての削除で試したら、削除されてしましました。

山内さんの情報をもとに、色々試してみます。
ありがとうございましたmm
・ツリー全体表示

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