как сделать папки основанными на значении строк

Question

Во-первых, я хочу написать макрос для прохождения каждой строки, поэтому, если значение элемента больше 10, создайте папку на основе значений этого ряда. Кроме того, без дублирующейся папки!например, если есть item20, то создайте папку с этим именем 20_NT25153_29.9, затем другие строки

Я хочу добавить это предложение, я знаю, что мой код очень прост, но я новичок в VBA, поэтому мне нужна дополнительная помощь:)

 Sub loopthrough()

    With Worksheets("Output_" & Date)
      fName5 = .Range("d").Value
      fName1 = .Range("B").Value
      fName2 = .Range("c").Value
      fName4 = "_"
      BrowseForFolder = CurDir()
    End With

    For Each cell In ActiveWorkbook.Worksheets
      If cell.Range("B").Value > "10" Then
          BrowseForFolder1 = BrowseForFolder & "\" & fName1 & fName2 & fName5
          MkDir BrowseForFolder1
      End If
    Next cell

   End Sub

Answer 1

Вы можете использовать этот код:

Sub Macro1()

Dim lLastRow As Long
Dim sPath As String, sNewFolder As String

sPath = CurDir()
lLastRow = Range("A" & Rows.Count).End(xlUp).Row

For i = 2 To lLastRow
    If Range("B" & i).Value > 10 Then
        sNewFolder = Range("B" & i).Value & "_" & Range("C" & i).Value & "_" & Range("D" & i).Value
        If Dir(sPath & "\" & sNewFolder, vbDirectory) = "" Then
            MkDir (sPath & "\" & sNewFolder)
        End If
    End If
    sNewFolder = vbNullString
Next

End Sub

Прежде всего я проверяю индекс последней строки на основе столбца A, чтобы не проходить по всей таблице.В цикле я использовал функцию Dir () с параметром vbDirectory, которая возвращает пустую строку, когда папка не существует, и в этом случае она создает папку.

Answer 2

это работает для кого-то нужно, так же, как я

Answer 3

Это то, что вам нужно?

Имя папки - это значение столбца B _ значение столбца C _ значение столбца D?

Sub loopthrough()

Dim cell As Range, fName4

BrowseForFolder = CurDir()
fName4 = "_"

With Worksheets("Output_" & Date)
    For Each cell In .Range("B1", .Range("B" & Rows.Count).End(xlUp))
        If cell.Value > 10 Then
            BrowseForFolder1 = BrowseForFolder & "\" & cell.Value & fName4 & cell.Offset(, 1).Value & fName4 & cell.Offset(, 2).Value
            MkDir BrowseForFolder1
        End If
    Next cell
End With

End Sub