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 質問
【47332】Re:ご教授お願いします。 ウッシ 07/3/8(木) 8:29 発言
【47335】Re:ご教授お願いします。 へっぽこ 07/3/8(木) 10:01 発言
【47367】早々のご教授ありがとうございます。 ポンズッポン 07/3/9(金) 4:30 質問
【47369】Re:早々のご教授ありがとうございます。 ウッシ 07/3/9(金) 9:25 発言
【47442】ウッシさんおはようございます。 ポンズッポン 07/3/10(土) 9:03 質問
【47445】Re:ウッシさんおはようございます。 ウッシ 07/3/10(土) 10:25 発言

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