Excel VBA質問箱 IV

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

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


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

34573 / 76734

←次へ　｜　前へ→


	【47369】Re:早々のご教授ありがとうございます。

ウッシ - 07/3/9(金) 9:25 -


	引用なし

	パスワード

こんにちは

例えば今日データ蓄積用のシートの「H55:H99」までデータを入力したとすると、
明日は「H100～」に入力するのですか？

データ蓄積用のシートをアクティブにして下記コードを実行して下さい。
追加されたシートのA、B列に計算式が表示されると思いますので、その部分をコピー
してここに貼り付けて提示して下さい。

Sub test()
　　Dim hs　　　　　As Worksheet
　　Dim r　　　　　 As Range
　　Dim s　　　　　 As Range
　　Dim aShName　　 As String
　　Dim v()　　　　 As String
　　Dim i　　　　　 As Long
　　Dim j　　　　　 As Long
　
　　aShName = ActiveSheet.Name '蓄積用シートをアクティブにして実行する事
　　i = 1
　　On Error Resume Next
　　For Each hs In Worksheets
　　　　If hs.Name <> aShName Then
　　　　　　Set r = hs.Cells.SpecialCells(xlCellTypeFormulas)
　　　　　　If Not r Is Nothing Then
　　　　　　　　For Each s In r
　　　　　　　　　　If InStr(s.Formula, aShName) > 0 Then
　　　　　　　　　　　　ReDim Preserve v(1 To 1, 1 To i + 1)
　　　　　　　　　　　　v(1, i) = hs.Name & "!" & s.Address
　　　　　　　　　　　　v(1, i + 1) = "'" & s.Formula
　　　　　　　　　　　　i = i + 2
　　　　　　　　　　End If
　　　　　　　　Next s
　　　　　　End If
　　　　　　Set r = Nothing
　　　　End If
　　Next
　　On Error GoTo 0
　　
　　If i > 1 Then
　　　　Application.ScreenUpdating = False
　　　　Set hs = Worksheets.Add
　　　　j = 1
　　　　hs.Cells(j, "A").Value = "計算式セットセル"
　　　　hs.Cells(j, "B").Value = "計算式"

　　　　For i = 1 To UBound(v, 2) Step 2
　　　　　　j = j + 1
　　　　　　hs.Cells(j, "A").Value = v(1, i)
　　　　　　hs.Cells(j, "B").Value = v(1, i + 1)
　　　　Next i
　　　　hs.Columns("A:B").AutoFit
　　　　Set hs = Nothing
　　　　Application.ScreenUpdating = True
　　End If
　　Erase v
　　　　　　
End Sub

4 hits

▼

【47329】ご教授お願いします。 ポンズッポン 07/3/8(木) 2:59