| |
少し手直しですが、、御免なさいJAKAさん
ちゃんとﾁｪｯｸ（コード）してないのですが
画面更新を停止とループの中のSELECTを辞めてあります。
また、ループの中のWorksheets(MAIN)は入らない気がしますが
>Sub 品番抽出プログラム()
>
> Dim BOOKNAME As String '元ファイル名
> Dim DISTINATION As String '変更ファイル名
> Dim MAIN As String 'アクティブシート名
> Dim KITEN As Range '原点
> Dim C As Integer '表MAIN最終行
> Dim HINBAN As String '品番名
> Dim A As Integer 'カウンタ
> Dim B As Integer 'サブカウンタ
> Dim FLAG As String
>
>Dim TB(1 To 6) As Variant '←ちゃんと２次元にしようかと思ったけれど１次元
Public WBK1 As Workbook
Public SH1 As Worksheet
Application.ScreenUpdating = False
Application.EnableEvents = False
> 'ファイルを開く
> BOOKNAME = Application.GetOpenFilename(MultiSelect:=False)
> Workbooks.Open Filename:=BOOKNAME
* Set WBK1 = ActiveWorkbook ' 現在ブック
' BOOKを開くとひらいたBOOKがアクティブに成ります
>
>
> 'シート名確保
> MAIN = Left(BOOKNAME, 12)
’ こういう方法もあります セルを指定はSH1.Cells(1, 1)で可能です
* MAIN＝ActiveSheet.Name
* Set SH1 = WBK1.ActiveSheet
> 'アクティブシート名取得
> Workbooks(BOOKNAME).Activate ’’これもいいらないのでは
> Set KITEN = Worksheets(MAIN).Range("A1")
> C = KITEN.CurrentRegion.Rows.Count '最終行取得
>
> A = 2
>
> Do While Len(Cells(A, 6)) > 0 'セルの文字数0ならば
> A = A + 1
> B = A - 1
>
> ’Sheets(MAIN).Select ？？このSELECTっているのかな？
’ ループにいる間同じｼｰﾄ指定ですね。
> FLAG = StrComp(Cells(A, 6), Cells(B, 6), vbTextCompare)
>
> If FLAG = 0 Then '一致していれば
’’ここも配列にしたほうが速いです。
''
変数の宣言は外でしてください
dim ZA as variant,ZB as variant
dim i as integer
ZA = SH1.Cells(A, 15).Resize(6,1).Value
BZ = SH1.Cells(B, 15).Resize(6,1).Value
for i=15 to 20
TB(i-14)=Cells(B, i) + Cells(A, i)
next i
Cells(B, 15).Resize(, 6).Value = TB
’ここにもSELECTがありましたSELECTすると遅くなります。
Range(Cells(A, 2), Cells(A, 4)).EntireRow.Delete
A = A - 1
Else
End If
Loop
>Erase TB '静的配列の中身消去。
>
Application.ScreenUpdating = False
Application.EnableEvents = False
End Sub
|
|
SK63
- 11/2/25(金) 17:52 -
