Warning: file_get_contents(/data/phpspider/zhask/data//catemap/5/excel/27.json): failed to open stream: No such file or directory in /data/phpspider/zhask/libs/function.php on line 167

Warning: Invalid argument supplied for foreach() in /data/phpspider/zhask/libs/tag.function.php on line 1116

Notice: Undefined index: in /data/phpspider/zhask/libs/function.php on line 180

Warning: array_chunk() expects parameter 1 to be array, null given in /data/phpspider/zhask/libs/function.php on line 181
Vba 如果单元格为空,则获取数据函数返回/(斜杠)_Vba_Excel - Fatal编程技术网

Vba 如果单元格为空,则获取数据函数返回/(斜杠)

Vba 如果单元格为空,则获取数据函数返回/(斜杠),vba,excel,Vba,Excel,我从封闭工作簿中的特定单元格中获取数据,但如果单元格为空,则会获取空单元格。我需要改进get data函数,以便在获取数据的单元格为空时,使用get data函数返回“/”或其他字符 多谢各位 Sub Recurse() Dim FSO As New FileSystemObject Dim myFolder As Scripting.Folder, mySubFolder As Scripting.Folder Dim myFile As File Dim sPath$: sPath = "C

我从封闭工作簿中的特定单元格中获取数据,但如果单元格为空,则会获取空单元格。我需要改进get data函数,以便在获取数据的单元格为空时,使用get data函数返回“/”或其他字符

多谢各位

Sub Recurse()
Dim FSO As New FileSystemObject
Dim myFolder As Scripting.Folder, mySubFolder As Scripting.Folder
Dim myFile As File
Dim sPath$: sPath = "C:\Users\Marek\Desktop\skuska\"
Dim R$
R = Join(Application.Transpose(Sheets("Sheet2").UsedRange), "|")
Set myFolder = FSO.GetFolder(sPath)
For Each mySubFolder In myFolder.SubFolders
For Each myFile In mySubFolder.Files
    DoEvents
    If Not (InStr(1, R, myFile.Path) > 0) Then
        GetData myFile, "Sheet1", "A1:A2",     Sheets("Sheet1").Range(Sheets(1).Cells(Sheet1.Cells(Rows.Count, 1).End(xlUp).Row + 1, 1), Sheets(1).Cells(Sheet1.Cells(Rows.Count, 1).End(xlUp).Row + 1, 1)), True, False
        GetData myFile, "Sheet1", "B1:B2", Sheets("Sheet1").Range(Sheets(1).Cells(Sheet1.Cells(Rows.Count, 2).End(xlUp).Row + 1, 2), Sheets(1).Cells(Sheet1.Cells(Rows.Count, 2).End(xlUp).Row + 1, 2)), True, False
        GetData myFile, "Sheet1", "C1:C2", Sheets("Sheet1").Range(Sheets(1).Cells(Sheet1.Cells(Rows.Count, 3).End(xlUp).Row + 1, 3), Sheets(1).Cells(Sheet1.Cells(Rows.Count, 3).End(xlUp).Row + 1, 3)), True, False
        Sheets("Sheet2").Cells(Sheets("Sheet2").UsedRange.Rows.Count + 1, 1).Value = myFile.Path
        R = R & myFile.Path & "|"
    End If
Next
Next
 Set FSO = Nothing
Set myFolder = Nothing
Set mySubFolder = Nothing
Set myFile = Nothing
端接头

Option Explicit


Public Sub GetData(SourceFile As Variant, SourceSheet As String, _
               SourceRange As String, TargetRange As Range, Header As Boolean,     UseHeaderRow As Boolean)
' 30-Dec-2007, working in Excel 2000-2007
Dim rsCon As Object
Dim rsData As Object
Dim szConnect As String
Dim szSQL As String
Dim lCount As Long

' Create the connection string.
If Header = False Then
    If Val(Application.Version) < 12 Then
        szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                    "Data Source=" & SourceFile & ";" & _
                    "Extended Properties=""Excel 8.0;HDR=No"";"
    Else
        szConnect = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                    "Data Source=" & SourceFile & ";" & _
                    "Extended Properties=""Excel 12.0;HDR=No"";"
    End If
Else
    If Val(Application.Version) < 12 Then
        szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                    "Data Source=" & SourceFile & ";" & _
                    "Extended Properties=""Excel 8.0;HDR=Yes"";"
    Else
        szConnect = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                    "Data Source=" & SourceFile & ";" & _
                    "Extended Properties=""Excel 12.0;HDR=Yes"";"
    End If
End If

If SourceSheet = "" Then
    ' workbook level name
    szSQL = "SELECT * FROM " & SourceRange$ & ";"
Else
    ' worksheet level name or range
    szSQL = "SELECT * FROM [" & SourceSheet$ & "$" & SourceRange$ & "];"
End If

On Error GoTo SomethingWrong

Set rsCon = CreateObject("ADODB.Connection")
Set rsData = CreateObject("ADODB.Recordset")

rsCon.Open szConnect
rsData.Open szSQL, rsCon, 0, 1, 1

' Check to make sure we received data and copy the data
If Not rsData.EOF Then

    If Header = False Then
        TargetRange.Cells(1, 1).CopyFromRecordset rsData
    Else
        'Add the header cell in each column if the last argument is True
        If UseHeaderRow Then
            For lCount = 0 To rsData.Fields.Count - 1
                TargetRange.Cells(1, 1 + lCount).Value = _
                rsData.Fields(lCount).Name
            Next lCount
            TargetRange.Cells(2, 1).CopyFromRecordset rsData
        Else
            TargetRange.Cells(1, 1).CopyFromRecordset rsData
        End If
    End If

Else
    MsgBox "No records returned from : " & SourceFile, vbCritical
End If

' Clean up our Recordset object.
rsData.Close
Set rsData = Nothing
rsCon.Close
Set rsCon = Nothing
Exit Sub

SomethingWrong:
MsgBox "The file name, Sheet name or Range is invalid of : " & SourceFile, _
       vbExclamation, "Error"
On Error GoTo 0

End Sub 
选项显式
公共子GetData(SourceFile作为变量,SourceSheet作为字符串_
SourceRange作为字符串,TargetRange作为范围,Header作为布尔值,UseHeaderRow作为布尔值)
'2007年12月30日,在Excel 2000-2007中工作
作为对象的Dim rsCon
将数据作为对象
作为字符串连接
作为字符串的SQL
暗淡如长
'创建连接字符串。
如果Header=False,则
如果Val(Application.Version)<12,则
szConnect=“Provider=Microsoft.Jet.OLEDB.4.0;”_
“数据源=”&SourceFile&“;”&”_
“扩展属性=”“Excel 8.0;HDR=No”“
其他的
szConnect=“Provider=Microsoft.ACE.OLEDB.12.0;”_
“数据源=”&SourceFile&“;”&”_
“扩展属性=”“Excel 12.0;HDR=否”“
如果结束
其他的
如果Val(Application.Version)<12,则
szConnect=“Provider=Microsoft.Jet.OLEDB.4.0;”_
“数据源=”&SourceFile&“;”&”_
“扩展属性=”“Excel 8.0;HDR=Yes”“
其他的
szConnect=“Provider=Microsoft.ACE.OLEDB.12.0;”_
“数据源=”&SourceFile&“;”&”_
“扩展属性=”“Excel 12.0;HDR=Yes”“
如果结束
如果结束
如果SourceSheet=“”,则
'工作簿级别名称
szSQL=“选择*自”&SourceRange$&
其他的
'工作表级别名称或范围
szSQL=“从[”&SourceSheet$&“$”&SourceRange$&“]中选择*
如果结束
在出错的时候出错了
设置rsCon=CreateObject(“ADODB.Connection”)
Set rsData=CreateObject(“ADODB.Recordset”)
rsCon.打开szConnect
rsData.openszsql,rsCon,0,1,1
'检查以确保我们收到数据并复制数据
如果不是rsData.EOF,则
如果Header=False,则
TargetRange.Cells(1,1).CopyFromRecordset rsData
其他的
'如果最后一个参数为True,则在每列中添加标题单元格
如果用的话
对于lCount=0到rsData.Fields.Count-1
TargetRange.Cells(1,1+L计数)。值=_
rsData.Fields(lCount.Name)
下一个帐户
TargetRange.Cells(2,1).CopyFromRecordset rsData
其他的
TargetRange.Cells(1,1).CopyFromRecordset rsData
如果结束
如果结束
其他的
MsgBox“未从以下位置返回任何记录:”&SourceFile,vbCritical
如果结束
'清理我们的记录集对象。
rsData,关闭
设置rsData=Nothing
rsCon.关闭
设置rsCon=Nothing
出口接头
出了点问题:
MsgBox“文件名、工作表名或范围无效:”&SourceFile_
“错误”感叹号
错误转到0
端接头

您需要逐个单元格循环查看收到的数据。。粘贴数据后,使用循环通过循环遍历目标范围(excel工作表上的数据范围)。就像:

for i = TargetRangeStartRow to numRowsInTargetRange
    for j = TargetRangeStartCol to numColsInTargetRange
        if Cells(i,j).formulaR1C1 = "" then
            Cells(i,j).formulaR1C1 = "/"
        end if
    next
next
其中显然需要使用目标源中的第一行和第一列,还需要获得目标范围中的行数和列数。我之所以说使用目标范围,是因为(我假设)是将数据粘贴到Excel中的范围


在Excel中,没有多少方法(我不认为?)查看access并提前查看是否有任何数据丢失。不管怎样,您仍然需要循环整个过程,所以最好在数据粘贴到Excel工作表之后再这样做

这看起来不错。但我的问题是,我需要在添加每一行之后执行这个循环。每次它都需要是表格的最后一行。我编辑代码并添加递归函数。我认为循环可能在这一行之后:R=R&myFile.Path&“|”。我需要检查已添加的最后一行。