Excel 如何根据行的值创建文件夹

首先，我想写一个宏来遍历每一行，所以如果项目的值大于10，则根据该行的值创建一个文件夹。此外，不要重复文件夹！ 例如，如果有item20，则创建一个名为20_NT25153_29.9的文件夹，然后创建另一行

我想添加这句话，我知道我的代码很简单，但我是VBA新手，因此需要更多帮助：）

---

这就是你想要的吗

文件夹名称是B列值uuC列值uD列值

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

---

这就是你想要的吗

文件夹名称是B列值uuC列值uD列值

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

---

您可以使用以下代码：

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

首先，我基于一列检查最后一行索引，而不是在整个工作表中循环。

---

在一个循环中，我使用了带有vbDirectory参数的Dir（）函数，当文件夹不存在时返回空字符串&在这种情况下，它会创建一个文件夹。

您可以使用以下代码：

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

首先，我基于一列检查最后一行索引，而不是在整个工作表中循环。

---

在一个循环中，我使用了一个带有vbDirectory参数的Dir（）函数，当文件夹不存在时返回空字符串&在这种情况下，它会创建一个文件夹。

它适用于和我一样需要的人

 Sub Macro1()

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

sPath = CurDir()
lLastRow =        workbooks(sFilename).Sheets(1).Range("A:A").SpecialCells(xlCellTypeLastCell).Row

Workbooks(sFilename).Sheets(1).Activate

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

 End Sub

---

它适用于和我一样需要的人

 Sub Macro1()

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

sPath = CurDir()
lLastRow =        workbooks(sFilename).Sheets(1).Range("A:A").SpecialCells(xlCellTypeLastCell).Row

Workbooks(sFilename).Sheets(1).Activate

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

 End Sub

---

感谢您的回复，但它没有出现任何错误：（我还有一个问题，我使用此代码并正常工作，但它为每行创建一个文件夹，是否可以为每一个相同的项目创建一个文件夹例如，在表中，我有两行，该项目=10我只需要每个项目的第一行，提前感谢感谢您的回复，但它没有任何错误：（我还有一个问题，我使用此代码并正常工作，但它为每行创建一个文件夹，是否可以为每个相同的项目创建一个文件夹例如，在表中，我有两行，其中item=10，我只需要为每个项目创建第一行，提前感谢。）