2023-09-13

■

Sub CopyDataFromReadOnlyFolder()
Dim FolderPath As String
Dim FileName As String
Dim ExcelApp As Object
Dim SourceWorkbook As Workbook
Dim TargetSheet As Worksheet

' フォルダのパスを指定します
FolderPath = "C:\Path\To\Your\ReadOnly\Folder\"

' フォルダ内の最初のExcelファイルを取得します
FileName = Dir(FolderPath & "*.xlsx")

' Excelアプリケーションを作成します
Set ExcelApp = CreateObject("Excel.Application")

If FileName <> "" Then
' Excelファイルを開きます（読み取り専用モード）
Set SourceWorkbook = ExcelApp.Workbooks.Open(FolderPath & FileName, ReadOnly:=True)

' シート3を取得します（thisworksheetを適切なシート名に変更してください）
Set TargetSheet = ThisWorkbook.Sheets("thisworksheet") ' thisworksheetを適切なシート名に変更

' データをコピーして貼り付けます
' シート1からシート3へのコピー
SourceWorkbook.Sheets(1).Range("A1").Copy Destination:=TargetSheet.Range("A1")
SourceWorkbook.Sheets(1).Range("B2").Copy Destination:=TargetSheet.Range("A2")
SourceWorkbook.Sheets(1).Range("C3").Copy Destination:=TargetSheet.Range("A3")

' シート2からシート3へのコピー
SourceWorkbook.Sheets(2).Range("B1").Copy Destination:=TargetSheet.Range("D1")
SourceWorkbook.Sheets(2).Range("B2").Copy Destination:=TargetSheet.Range("G2")
SourceWorkbook.Sheets(2).Range("B3").Copy Destination:=TargetSheet.Range("D3")

' Excelファイルを閉じます
SourceWorkbook.Close SaveChanges:=False ' 変更を保存しない

' Excelアプリケーションを終了します
ExcelApp.Quit
Else
MsgBox "指定したフォルダ内にExcelファイルが見つかりませんでした。", vbExclamation
End If

' オブジェクトを解放します
Set SourceWorkbook = Nothing
Set TargetSheet = Nothing
Set ExcelApp = Nothing
End Sub

2023-08-18

■

VBAを使用して、ユーザーフォームを作成し、コマンドボタンが押されたときにファイルを選択するダイアログを表示し、選択したファイルのパスをテキストボックスに表示する方法を以下に示します。

Visual Basic for Applications（VBA）エディタを開きます（通常、Alt + F11を押します）。
"挿入"メニューから「ユーザーフォーム」を選択して新しいユーザーフォームを作成します。
フォームデザイナーで、コマンドボタン（CommandButton）とテキストボックス（TextBox）をフォームに追加します。

以下がコードのサンプルです。

vba

Option Explicit

Private Sub CommandButton1_Click()
    Dim selectedFilePath As String
    
    ' ファイルを選択するダイアログを表示
    selectedFilePath = SelectFile()
    
    ' 選択されたファイルパスをテキストボックスに表示
    If selectedFilePath <> "" Then
        TextBox1.Text = selectedFilePath
    End If
End Sub

Private Function SelectFile() As String
    Dim fileDialog As FileDialog
    Dim filePath As String
    
    ' ファイルを選択するダイアログを作成
    Set fileDialog = Application.FileDialog(msoFileDialogFilePicker)
    
    ' ダイアログを表示
    If fileDialog.Show = -1 Then
        filePath = fileDialog.SelectedItems(1)
    End If
    
    SelectFile = filePath
End Function

上記のコードは、ユーザーフォームにコマンドボタン（CommandButton）とテキストボックス（TextBox）を配置し、コマンドボタンがクリックされたときにファイルを選択するダイアログを表示し、選択したファイルのパスをテキストボックスに表示します。

注意: 上記のコードを適切なVBAプロジェクト内で使用するためには、フォームのコントロール名やプロシージャ名、フォーム内でのコントロール配置などを適切に調整する必要があります。また、ファイルダイアログの表示方法なども環境によって異なる場合があるため、適宜調整してください。

2023-08-18

■

Sub DeleteRowsIfValuesMatch()
Dim ws As Worksheet
Dim lastRow As Long, i As Long
Dim rng As Range

' 対象のシートを設定
Set ws = ThisWorkbook.Sheets("Sheet1") ' シート名を適切に変更

' 最終行を取得
lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row

' 下から上に向かってチェックし、同じ値があれば行を削除
For i = lastRow - 1 To 2 Step -1
Set rng = ws.Range("B" & i & ":G" & i) ' 対象行の範囲を取得
If Application.WorksheetFunction.CountIf(rng, rng.Cells(1, 1).Value) = rng.Cells.Count Then
rng.EntireRow.Delete
End If
Next i
End Sub

2023-07-23

なし

おっしゃる通り、ラベル1に日付が記入されると同時にラベル3に結果を表示するようにコードを変更することができます。

```vba
Private Sub Label1_Change()
Dim inputDate As Date
Dim outputDate As Date

' 入力された日付を取得
inputDate = CDate(Me.Label1.Caption)

' 4日後の日付を計算
outputDate = inputDate + 4

' 土日、祝日の場合は翌平日にずらす
Do Until isWeekday(outputDate) And Not isHoliday(outputDate)
outputDate = outputDate + 1
Loop

' ラベル3に結果を表示
Me.Label3.Caption = Format(outputDate, "yyyy\\\/mm\\\/dd")
End Sub

Function isWeekday(ByVal checkDate As Date) As Boolean
' 土日の場合はFalseを返す
If Weekday(checkDate, vbSunday) = vbSaturday Or Weekday(checkDate, vbSunday) = vbSunday Then
isWeekday = False
Else
isWeekday = True
End If
End Function

Function isHoliday(ByVal checkDate As Date) As Boolean
Dim holidaySheet As Worksheet
Dim holidayRange As Range

' 祝日シートを取得
Set holidaySheet = ThisWorkbook.Sheets("祝日シート")

' A列の全範囲を取得
Set holidayRange = holidaySheet.Range("A:A")

' 祝日一覧に含まれているかチェック
If WorksheetFunction.CountIf(holidayRange, checkDate) > 0 Then
isHoliday = True
Else
isHoliday = False
End If
End Function
```

上記のコードでは、`Label1_Change()`イベントが発生した時に実行される処理を定義しています。`Label1`の内容が変更されると、`Label1_Change()`が呼び出されます。それにより、4日後の平日が計算され、結果が`Label3`に表示されます。

注意: コード中の`"祝日シート"`という部分は、実際の祝日一覧が記載されているシート名に置き換えてください。

chatGPTで適当に自分用に貼り付け用

おもにエクセルのマクロ

■

■

■

なし