パソコン

フリーページ

< 新しい記事

新着記事一覧(全201件)

過去の記事 >

2025年02月07日

テスト

カテゴリ：カテゴリ未分類

Sub ExtractFolderAccessRights()

Dim logSheet As Worksheet, folderSheet As Worksheet
Dim lastLogRow As Long, lastCol As Long, lastFolderRow As Long
Dim i As Long, j As Long, k As Long
Dim folderPath As String, topFolderPath As String
Dim folderName As String
Dim targetName As String
Dim accessRights As String

' シートを設定

Set folderSheet = ThisWorkbook.Sheets("folder")

' 最終行と最終列を取得
lastLogRow = logSheet.Cells(Rows.Count, "C").End(xlUp).Row
lastCol = folderSheet.Cells(1, Columns.Count).End(xlToLeft).Column
lastFolderRow = folderSheet.Cells(Rows.Count, "B").End(xlUp).Row ' フォルダシートの最終行を取得

' folderシートのB2から最終列までループ
For j = 2 To lastCol

targetName = folderSheet.Cells(1, j).Value ' 検索対象の名前

' 結果を書き出す最初の行を設定 (folderSheetのB3から)
k = 3

' logシートの2行目から最終行までループ

folderPath = logSheet.Cells(i, "C").Value
folderName = logSheet.Cells(i, "G").Value ' アクセス権者名が入っている最初の列

' G列からAD列までループ
For l = 7 To 30 ' 列番号7はG列、30はAD列

' 名前が一致する場合

' 最上位のフォルダパスを取得
topFolderPath = GetTopFolderPath(folderPath)

' 結果をfolderシートに書き出す (重複チェック)
If Not IsDuplicate(folderSheet, k - 1, topFolderPath) Then
folderSheet.Cells(k, j).Value = topFolderPath
k = k + 1
End If

Exit For ' 一致する名前が見つかったら、その行のループを抜ける
End If
Next l
Next i
Next j

End Sub

' 最上位のフォルダパスを取得する関数
Function GetTopFolderPath(folderPath As String) As String

Dim parts() As String
parts = Split(folderPath, "\")

' 最上位のフォルダパスを組み立てる
GetTopFolderPath = parts(1) & "\" & parts(2)

End Function

' 重複チェック関数
Function IsDuplicate(sheet As Worksheet, lastRow As Long, folderPath As String) As Boolean

Dim i As Long

For i = 3 To lastRow ' 3行目から最終行までチェック
If sheet.Cells(i, 2).Value = folderPath Then ' 2列目で比較
IsDuplicate = True
Exit Function
End If
Next i

IsDuplicate = False

End Function

お気に入りの記事を「いいね！」で応援しよう