VBA マクロの組み方2

https://oshiete.goo.ne.jp/qa/10424572.html

上記質問に追加させてください

やりたいこと4
下記コードもセルではなく
シート1の2行目、各項目名で指定できないでしょうか。
A "検索コード"
B "契約番号"
N "企業名"
O "削除1"
P "削除2"
Q "削除3"
R "削除4"
S "削除5"

Dim i As Long, lastRow As Long, myRow As Long
Dim myRng As Range '//最初の処理//
lastRow = Cells(Rows.Count, "B").End(xlUp).Row
For i = lastRow To 2 Step -1
If Cells(i, "A").HasFormula Then
myRow = i
Exit For
End If
Next i
Range(Cells(myRow, "A"), Cells(lastRow, "A")).Formula = Cells(myRow, "A").Formula '//N列以降の処理//

lastRow = Cells(Rows.Count, "N").End(xlUp).Row
For i = lastRow To 2 Step -1
If Cells(i, "O").HasFormula Then
myRow = i
Exit For
End If
Next i
Set myRng = Range(Cells(myRow, "O"), Cells(myRow, "S"))
Range(Cells(myRow, "O"), Cells(lastRow, "S")).Formula = myRng.Formula


やりたいこと5
データの追加が発生した際、やりたいこと2のコードのままだと、最初から最後までコピーすることになり
おそらく処理が遅くなります。
それに伴いまして、下記のような動きで
シート1の2行目、"削除5"にデータが追加された分だけ
コピーすることはできないでしょうか。
T 企業名2

Range("T3").End(xlDown).Select
ActiveCell.Offset(1, -1).Activate
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
ActiveCell.Offset(0, 1).Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks :=False, Transpose:=False

質問者からの補足コメント

• 

  ＞何を指定したいのでしょう？
  仮に Cells(? , "A") の"A"を"検索コード"にしたいと言うならExcel的に不可能かと。
  ACCESSなどデータベースであればフィールド名として使えますが。
  
  →https://oshiete.goo.ne.jp/qa/10424572.html
  Set c = Rows(2).Find(what:="解約日", LookIn:=xlValues, lookat:=xlWhole)
  上記のような感じで変数とFindメゾットをうまく使って
  この処理にも適用できないかと考えました。
  
  
  ＞実際に遅くなったのでしょうか？
  数秒だったのが数分にとか。
  
  →実際に見てみたところ、
  年間でおよそ5000行増え、
  だいぶ時間がかかっているように感じます。
  少しでも所要時間を減らしたいです。

  No.1の回答に寄せられた補足コメントです。 補足日時：2018/04/12 13:18

• 

  ご回答ありがとうございます。
  
  ママチャリ様から頂いたコードが異なる動きをしたので
  ママチャリさんのコードを元に
  アレンジをしました。
  ですが
  矢印のところで「型が違う」というエラーがでます。
  どのように修正したらよいか
  ご教示頂けますと幸いです。

  No.4の回答に寄せられた補足コメントです。 補足日時：2018/04/16 14:27

• 

  With Sheets("データまとめ")
  Set FoundCell_a = .Range("2:2").Find(What:="検索コード", lookat:=xlWhole)
  Set FoundCell_b = .Range("2:2").Find(What:="契約番号", lookat:=xlWhole)
  Dim i As Long, lastRow As Long, myRow As Long
  Dim myRng As Range '//最初の処理//
  → lastRow = Cells(Rows.Count, FoundCell_b).End(xlUp).Row←

    補足日時：2018/04/16 14:27

• 

  For i = lastRow To 2 Step -1
  If Cells(i, FoundCell_a).HasFormula Then
  myRow = i
  Exit For
  End If
  Next i
  Range(Cells(myRow, FoundCell_a), Cells(lastRow, FoundCell_a)).Formula = Cells(myRow, FoundCell_a).Formula
  
  End With

    補足日時：2018/04/16 14:28

No.4 ベストアンサー 回答者： ママチャリ 回答日時： 2018/04/12 17:11

めぐみんさんの『名前の定義』は素敵なアイデアですね。

こんな感じでしょうか？
処理時間が伸びているのは、数式をコピーすることによる計算のためだと思われます。データ量に比例して時間がかかるような式になっていませんか？もしそうであればVBAを修正しても効果は望めません。

Sub sample()
Dim A, B, N, O, P, Q, R, S

Rows("1:2").CreateNames Top:=True

A = Range("検索コード").Column
B = Range("契約番号").Column
N = Range("企業名").Column
O = Range("削除1").Column
P = Range("削除2").Column
Q = Range("削除3").Column
R = Range("削除4").Column
S = Range("削除5").Column

Dim i As Long, lastRow As Long, myRow As Long
Dim myRng As Range '//最初の処理//
lastRow = Cells(Rows.Count, B).End(xlUp).Row
For i = lastRow To 2 Step -1
If Cells(i, A).HasFormula Then
myRow = i
Exit For
End If
Next i
Range(Cells(myRow, A), Cells(lastRow, A)).Formula = Cells(myRow, A).Formula '//N列以降の処理//

lastRow = Cells(Rows.Count, N).End(xlUp).Row
For i = lastRow To 2 Step -1
If Cells(i, "O").HasFormula Then
myRow = i
Exit For
End If
Next i
Set myRng = Range(Cells(myRow, O), Cells(myRow, S))
Range(Cells(myRow, O), Cells(lastRow, S)).Formula = myRng.Formula

End Sub

この回答へのお礼

このコードを元に作成できました。
ありがとうございました。

お礼日時：2018/04/16 15:03

No.3 回答者： fujillin 回答日時： 2018/04/12 16:54

こんにちは

少し別の発想になりますが、いろいろな項目を探したいのなら、まとめて取得しておく方法も考えられそうに思います。

例えば、最初の方で
Dim itms, itmColumn() As Long, i As Integer

Const items = "検索コード,契約番号,企業名,削除1,削除2,削除,削除4,削除5"

itms = Split(items, ",")
ReDim itmColumn(UBound(itms))

On Error Resume Next
For i = 0 To UBound(itms)
itmColumn(i) = Rows(2).Find(what:=itms(i), LookIn:=xlValues, lookat:=xlWhole).Column
Next
On Error GoTo 0

のような処理を行っておくと、各項目の列番号をitmColumnに順に取得できます。
（項目はConst itemsで指定していますが、項目数は可変です）
対象とする項目が見つからない場合は、itmColumnの値が0になりますので、それぞれの項目を対象とする処理を行う前に、項目の存在をチェックすることも可能です。

例えば、
　If itmColumn(0) Then
　　’検索コードの列に関する処理
　Else
' 項目が見つからない場合の処理
　End If

といった感じです。

No.2 回答者： めぐみん_ 回答日時： 2018/04/12 15:46

No.1の補足を見て。

１．

Dim r As Range
Set r = Range("A:A").SpecialCells(xlCellTypeFormulas)
MsgBox r.SpecialCells(xlCellTypeLastCell).Row

これでA列に数式がセットされてるセルのうち、一番後ろの行番号は取得できます。
ただし全てのセルに数式がセットされてないとエラーを起こしますね。
それを回避しての１つずつのチェックなのでは？
⇒Findメソッドで検索しても見つからない場合の処理が必要になってきますし。
一応一番後ろの行数を求めるのなら、

Dim r As Range
Set r = Range("A:A").Find(What:="*", After:=Cells(Rows.Count, 1), LookIn:=xlFormulas, SearchDirection:=xlPrevious)
MsgBox r.Row

O列を検索するのも同じですが、それぞれの列に『名前の定義』でもしない限り各項目名で指定は無理なのでは？

２．

シートの中身についてはわからないですが先にも申し上げたように下に追記していくのであれば、最終行同士を比較して差分を得れば良いと思いますよ。

No.1 回答者： めぐみん_ 回答日時： 2018/04/12 12:32

・やりたいこと４

＞各項目名で指定できないでしょうか。

何を指定したいのでしょう？
仮に Cells(? , "A") の"A"を"検索コード"にしたいと言うならExcel的に不可能かと。
ACCESSなどデータベースであればフィールド名として使えますが。

・やりたいこと５

データの追加がどのようになっているのかはわかりませんが、順次最終行の次に追加するのなら共に最終行を取得すればその差分はわかるのではないかと。

＞最初から最後までコピーすることになり
＞おそらく処理が遅くなります。

実際に遅くなったのでしょうか？
数秒だったのが数分にとか。