如果有人能给我一些帮助,我真的很感激。
我对vba非常熟悉,我可以编写简单的代码,也可以自定义其他代码。我已经编写/定制/复制了几段vba代码来执行以下操作(确认复制的源代码):
不幸的是我似乎无法让它运行。 知道我没做错的吗? 请参阅下面的代码。非常感谢。 代码已从先前版本更改
Public Sub doIt()
Dim sourceFile As String
Dim destinationFile As String
Dim data As Variant
Dim result As Variant
Dim sourceFile2 As String
Dim datarain As Variant
sourceFile = "C:\file1.csv"
sourceFile2 = "C:\file2.csv"
destinationFile = "C:\file3.txt"
data = getDataFromFile(sourceFile, ",")
datarain = getDataFromFile(sourceFile2, ",")
If Not isArrayEmpty(data) Then
result = MMULT2_FUNC(data, datarain)
writeToCsv result, destinationFile, ","
Else
MsgBox ("Empty file")
End If
End Sub
Function MMULT2_FUNC(ByRef ADATA_RNG As Variant, _
ByRef BDATA_RNG As Variant)
Dim i As Long
Dim j As Long
Dim k As Long
Dim ANROWS As Long
Dim BNROWS As Long
Dim ANCOLUMNS As Long
Dim BNCOLUMNS As Long
Dim ADATA_MATRIX As Variant
Dim BDATA_MATRIX As Variant
Dim TEMP_MATRIX As Variant
On Error GoTo ERROR_LABEL
ADATA_MATRIX = ADATA_RNG
BDATA_MATRIX = BDATA_RNG
ANROWS = UBound(ADATA_MATRIX, 1)
BNROWS = UBound(BDATA_MATRIX, 1)
ANCOLUMNS = UBound(ADATA_MATRIX, 2)
BNCOLUMNS = UBound(BDATA_MATRIX, 2)
If ANCOLUMNS <> BNROWS Then: GoTo ERROR_LABEL
ReDim TEMP_MATRIX(1 To ANROWS, 1 To BNCOLUMNS)
For i = 1 To ANROWS
For j = 1 To BNCOLUMNS
TEMP_MATRIX(i, j) = 0
For k = 1 To ANCOLUMNS
TEMP_MATRIX(i, j) = TEMP_MATRIX(i, j) + ADATA_MATRIX(i, k) * _
BDATA_MATRIX(k, j)
Next k
Next j
Next i
MMULT2_FUNC = TEMP_MATRIX
Exit Function
ERROR_LABEL:
MMULT2_FUNC = Err.Number
End Function
Public Sub writeToCsv(parData As Variant, parFileName As String, parDelimiter As String)
If getArrayNumberOfDimensions(parData) <> 2 Then Exit Sub
Dim i As Long
Dim j As Long
Dim FileNum As Long
Dim locLine As String
Dim locCsvString As String
FileNum = FreeFile
If Dir(parFileName) <> "" Then Kill (parFileName)
Open parFileName For Binary Lock Read Write As #FileNum
For i = LBound(parData, 1) To UBound(parData, 1)
locLine = ""
For j = LBound(parData, 2) To UBound(parData, 2)
If IsError(parData(i, j)) Then
locLine = locLine & "#N/A" & parDelimiter
Else
locLine = locLine & parData(i, j) & parDelimiter
End If
Next j
locLine = Left(locLine, Len(locLine) - 1)
If i <> UBound(parData, 1) Then locLine = locLine & vbCrLf
Put #FileNum, , locLine
Next i
error_handler:
Close #FileNum
End Sub
Public Function isArrayEmpty(parArray As Variant) As Boolean
'Returns false if not an array or dynamic array that has not been initialised (ReDim) or has been erased (Erase)
If IsArray(parArray) = False Then isArrayEmpty = True
On Error Resume Next
If UBound(parArray) < LBound(parArray) Then isArrayEmpty = True: Exit Function Else: isArrayEmpty = False
End Function
Public Function getArrayNumberOfDimensions(parArray As Variant) As Long
'Returns the number of dimension of an array - 0 for an empty array.
Dim i As Long
Dim errorCheck As Long
If isArrayEmpty(parArray) Then Exit Function 'returns 0
On Error GoTo FinalDimension
'Visual Basic for Applications arrays can have up to 60000 dimensions
For i = 1 To 60001
errorCheck = LBound(parArray, i)
Next i
'Not supposed to happen
getArrayNumberOfDimensions = 0
Exit Function
FinalDimension:
getArrayNumberOfDimensions = i - 1
End Function
Private Function getDataFromFile(parFileName As String, parDelimiter As String, Optional parExcludeCharacter As String = "") As Variant
'parFileName is supposed to be a delimited file (csv...)
'parDelimiter is the delimiter, "," for example in a comma delimited file
'Returns an empty array if file is empty or can't be opened
'number of columns based on the line with the largest number of columns, not on the first line
'parExcludeCharacter: sometimes csv files have quotes around strings: "XXX" - if parExcludeCharacter = """" then removes the quotes
Dim locLinesList() As Variant
Dim locData As Variant
Dim i As Long
Dim j As Long
Dim locNumRows As Long
Dim locNumCols As Long
Dim fso As Variant
Dim ts As Variant
Const REDIM_STEP = 10000
Set fso = CreateObject("Scripting.FileSystemObject")
On Error GoTo error_open_file
Set ts = fso.OpenTextFile(parFileName)
On Error GoTo unhandled_error
'Counts the number of lines and the largest number of columns
ReDim locLinesList(1 To 1) As Variant
i = 0
Do While Not ts.AtEndOfStream
If i Mod REDIM_STEP = 0 Then
ReDim Preserve locLinesList(1 To UBound(locLinesList, 1) + REDIM_STEP) As Variant
End If
locLinesList(i + 1) = Split(ts.ReadLine, parDelimiter)
j = UBound(locLinesList(i + 1), 1) 'number of columns
If locNumCols < j Then locNumCols = j
If j = 13 Then
j = j
End If
i = i + 1
Loop
ts.Close
locNumRows = i
If locNumRows = 0 Then Exit Function 'Empty file
ReDim locData(1 To locNumRows, 1 To locNumCols + 1) As Variant
'Copies the file into an array
If parExcludeCharacter <> "" Then
For i = 1 To locNumRows
For j = 0 To UBound(locLinesList(i), 1)
If Left(locLinesList(i)(j), 1) = parExcludeCharacter Then
If Right(locLinesList(i)(j), 1) = parExcludeCharacter Then
locLinesList(i)(j) = Mid(locLinesList(i)(j), 2, Len(locLinesList(i)(j)) - 2) 'If locTempArray = "", Mid returns ""
Else
locLinesList(i)(j) = Right(locLinesList(i)(j), Len(locLinesList(i)(j)) - 1)
End If
ElseIf Right(locLinesList(i)(j), 1) = parExcludeCharacter Then
locLinesList(i)(j) = Left(locLinesList(i)(j), Len(locLinesList(i)(j)) - 1)
End If
locData(i, j + 1) = locLinesList(i)(j)
Next j
Next i
Else
For i = 1 To locNumRows
For j = 0 To UBound(locLinesList(i), 1)
locData(i, j + 1) = locLinesList(i)(j)
Next j
Next i
End If
getDataFromFile = locData
Exit Function
error_open_file: 'returns empty variant
unhandled_error: 'returns empty variant
End Function
答案 0 :(得分:0)
尽管我个人认为你的代码在某些情况下可以改进,但它在语法上执行没有问题(在小矩阵上)。
我的测试数据
1,2,3 2,3,4 20,26,32
2,3,4 X 3,4,5 = 29,38,47
3,4,5 4,5,6 38,50,62
结果整齐地写入CSV。
只有明显的问题(在Win 7上这里!)是Sub writeToCsv -> Open parFileName
...由于缺少对根目录的写权限而失败。这可能不是XP的问题。
在另一个令牌上,我的印象是代码可以改进,但我可能不理解代码某些部分背后的基本原理。
实施例
Function MMULT2_FUNC(ByRef ADATA_RNG As Variant, ByRef BDATA_RNG As Variant) ' missing type of result
Private Function getDataFromFile(...)
...
If j = 13 Then
j = j
End If ' whow ... if j <> 13 then j again equals j ;-)
在输入和输出上找到矩阵的上下界可以大大简化......
答案 1 :(得分:0)
谢谢大家的帮助。我的代码没有打印结果的原因是我有这个:If ANCOLUMNS <> BNROWS Then: GoTo ERROR_LABEL
。与此同时,我使用了两个70 * 120的矩阵,所以它不断退出功能,因为我已经编程完成了!!纠正了一切并且工作正常。非常感谢您的帮助