Sub CopyFirstColumnToNewFile()
' エクスプローラーからファイルを選択する
Dim fileToOpen As Variant
fileToOpen = Application.GetOpenFilename("Excel Files (*.xlsx),*.xlsx")
If fileToOpen = False Then Exit Sub
' 選択されたファイルを開く
Dim wb As Workbook
Set wb = Workbooks.Open(fileToOpen)
' 出力用のファイルを開く
Dim outFileNum As Integer
outFileNum = FreeFile()
Dim outFileName As String
outFileName = "Output_" & Format(Now(), "yyyymmdd_hhmmss") & ".csv" ' 出力ファイル名を設定する
Open outFileName For Output As outFileNum
' 最初のシートの1列ずつ読み込んで出力ファイルに書き込む
Dim ws As Worksheet
Set ws = wb.Sheets(1)
Dim lastRow As Long
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row ' 列の最終行を取得する
Dim i As Long
For i = 1 To lastRow
Print #outFileNum, ws.Cells(i, 1).Value ' 1行ずつ書き込む
Next i
' ファイルを閉じる
Close outFileNum
' ファイルを閉じる
wb.Close False
End Sub
この例では、ActiveSheetオブジェクトを使用して、アクティブなシートを取得しています。出力ファイルには、列の値が1行ずつ書き込まれます。出力ファイル名には、現在の日時が付加されているため、ファイル名が重複することがなくなります
Sub CopyFirstColumnToNewFile()
' エクスプローラーからファイルを選択する
Dim fileToOpen As Variant
fileToOpen = Application.GetOpenFilename("Excel Files (*.xlsx),*.xlsx")
If fileToOpen = False Then Exit Sub
' 選択されたファイルを開く
Dim wb As Workbook
Set wb = Workbooks.Open(fileToOpen)
' 出力用のファイルを開く
Dim outFileNum As Integer
outFileNum = FreeFile()
Dim outFileName As String
outFileName = "Output_" & Format(Now(), "yyyymmdd_hhmmss") & ".csv" ' 出力ファイル名を設定する
Open outFileName For Output As outFileNum
' 最初のシートの1列ずつ読み込んで出力ファイルに書き込む
Dim ws As Worksheet
Set ws = wb.Sheets(1)
Dim lastRow As Long
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row ' 列の最終行を取得する
Dim i As Long
For i = 1 To lastRow
Print #outFileNum, ws.Cells(i, 1).Value ' 1行ずつ書き込む
Next i
' ファイルを閉じる
Close outFileNum
' ファイルを閉じる
wb.Close False
End Sub
Sub HashColumn()
Dim fileDialog As FileDialog
Set fileDialog = Application.FileDialog(msoFileDialogFilePicker)
Dim selectedFile As String
Dim wb As Workbook
Dim ws As Worksheet
'エクスプローラーからファイルを選択して開く
With fileDialog
.Title = "Excelファイルを選択してください"
.AllowMultiSelect = False
.Filters.Clear
.Filters.Add "Excelファイル", "*.xlsx;*.xls"
If .Show = -1 Then
selectedFile = .SelectedItems(1)
Else
Exit Sub
End If
End With
'選択されたファイルを開く
Set wb = Workbooks.Open(selectedFile)
Set ws = wb.Worksheets(1)
'新しいファイルを作成して1行目にヘッダーを追加する
Dim newWB As Workbook
Set newWB = Workbooks.Add
Dim newWS As Worksheet
Set newWS = newWB.Worksheets(1)
newWS.Cells(1, 1).Value = "Hashed Values"
'1列目のすべてのセルを1行ずつMD5でハッシュ化して新しいファイルに貼り付ける
Dim lastRow As Long
lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row '1列目の最終行を取得する
Dim i As Long
For i = 1 To lastRow
Dim hashValue As String
hashValue = MD5Hash(ws.Cells(i, 1).Value) '1列目のセルをMD5でハッシュ化する
newWS.Cells(i + 1, 1).Value = hashValue '新しいファイルにハッシュ値を貼り付ける
Next i
'ハッシュ値を作成するMD5関数
Function MD5Hash(ByVal strToHash As String) As String
Dim md5Obj As Object
Set md5Obj = CreateObject("System.Security.Cryptography.MD5CryptoServiceProvider")
Dim bytesToHash() As Byte
bytesToHash = StrConv(strToHash, vbFromUnicode) '文字列をバイト配列に変換する
Dim bytesHashed() As Byte
bytesHashed = md5Obj.ComputeHash_2((bytesToHash)) 'バイト配列をMD5でハッシュ化する
MD5Hash = StrConv(bytesHashed, vbUnicode) 'ハッシュ値を文字列に変換する
End Function
'新しいファイルを保存する
Dim newFileName As String
newFileName = "Hashed_" & Format(Now(), "yyyymm