EXCELマクロ

■終端業を調べる時
 Cells(Rows.Count, 1).End(xlUp).ROW


    With ActiveSheet
        'オートフィルターが設定されているかチェック        If .AutoFilterMode Then            '非表示行をすべて表示            .AutoFilter.ShowAllData        End If    End With

 Application.ScreenUpdating = False
 Application.ScreenUpdating = True

---------------------------------------------------------------------------------------------
Option Explicit '変数宣言を強制(処理速度の向上のため)
'■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■
'モジュール内で使える変数
'■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■
Private xNUM_Sheets As Long 'シート数カウント用
Private xNUM_Row As Long '行カウント用
'■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■
'参照データを入れる為の変数(構造体)
'■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■
Type kDATA_B
x01_Date As Date '日付
x02_Name As String '名前
x03_Objective As String '目的

x11_EXCEL_Name As String 'エクセル名
x12_Sheet_Name As String 'シート名
x13_Row As Long '行
End Type
'■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■
'EXCELファイルを開いてコピペするやり方
'【参考:基本】  https://rikei-fufu.com/2019/05/09/post-1025-vba3/
'【参考:拡張子】 https://www.sejuku.net/blog/34458
'■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■
Sub OPEN_ExcelBook()
Dim FileName As String '参照先ファイル名
Dim ret As Variant 'ファイルを開いた時の戻り値

Dim mainSheet As Worksheet 'コピー先のシート名
Dim xSheet As Worksheet '参照先シート名
Dim xBook As Workbook '参照先ブック名

Set mainSheet = Worksheets("データベース")

'ファイル選択ダイアログを表示
ret = Application.GetOpenFilename("Excelファイル(*.xls),*.xls?")

'キャンセルされた場合
If ret = False Then
'MsgBox "キャンセルされました"
Exit Sub
End If

FileName = CStr(ret)

'参照EXCELファイルをOpen
Workbooks.Open FileName

Set xBook = ActiveWorkbook
Set xSheet = ActiveSheet

Call SET_DATA 'データ収集

'参照EXCELをシートごとコピー
xSheet.Copy After:=mainSheet

'参照EXCELを閉じる
xBook.Close

Set xBook = Nothing
Set xSheet = Nothing
Set mainSheet = Nothing
End Sub
'■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■
'参照データを変数(構造体)に入れます。
'■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■
Sub SET_DATA()
Dim xDATA() As kDATA_B '変数(構造体)の宣言
Dim xSheet_NUM As Integer 'シート数
Dim xROWS() As Long '行数(20行目からデータが何行あるか)
Dim xCNT_Row As Long 'カウント用_行数
Dim xCNT_Sheets As Long 'カウント用_シート数
xSheet_NUM As Worksheets.Count
ReDim xROWS(xSheet_NUM)

For xCNT_Sheets = 1 To xSheet_NUM
If Cells(20, 1) = "" Then
xROWS(xCNT_Sheets) = 0 'データは何も無し。
ElseIf Cells(20, 1) <> "" And Cells(21, 1) = "" Then
xROWS(xCNT_Sheets) = 1 'データ数1
ElseIf Cells(20, 1) <> "" And Cells(21, 1) <> "" And Cells(22, 1) = "" Then
xROWS(xCNT_Sheets) = 2 'データ数2
Else
xROWS(xCNT_Sheets) = Range("A20").End(xlDown).Row - 19 'データ数(3以上)
End If

'xROWS(xCNT_Sheets)=


Next xcnt

'redim xSheet_NUM()



ReDim xDATA(10, 10)

End Sub

"EXCELマクロ" へのコメントを書く

お名前
メールアドレス
ホームページアドレス
コメント