在已建立的VBA项目中更改数据提取

时间:2016-05-31 12:50:32

标签: excel vba excel-vba

快速背景。我是小型企业的SOLO IT管理员/总监,我的优势在于管理,工作站,服务器支持,虚拟化和“小工具”。他们希望我最终将一些非常需要的注意力转向我们过多的包含大量VBA的Excel电子表格,其中许多已经使用了10年以上。我是比赛,但是在我之前接受了一些研究。

我的任务是更改工作表抓取数据的方式。

Sheet looks like this

当我开始处理这个项目时,我添加了W列,并将在下面解释......

基本上,此工作表根据日期范围从另一个工作表中获取数据(作业编号),并使用其他子程序计算它们,并将这些工作编号放在从C2开始的单元格中。为了这篇文章的缘故,不需要担心所有其他细胞,因为如果我能够开始这样做,其余细胞就会落实到位。

我们希望无需根据日期范围查看其他工作表以获取作业编号,只需让宏(RUN REPORT,左上角)抓住W列中列出的“作业”,用户将手动输入

有两个代码块用于获取此数据......

Sub IMPORT_ALL_INFORMATION()

'Set variables
Dim file_in As Long
Dim strInput As Variant
Dim i As Integer
Dim j As Integer
Dim l As Integer
Dim sTmp As String
Dim sJob As String
Dim sSchedPath As String

'end setting variables
Sheets("REPORT").Select
Range("C2").Select

sSchedPath = "C:\Temp"
Call apiCopyFile("\servername\Applications\Schedule\schedule-s\schedule, S.xls", "C:\Temp\schedule, S.xls", 0)
dteStart = Application.Sheets("Report").Range("$G$27").Value
dteEnd = Application.Sheets("Report").Range("$J$27").Value
l = 4 ' First data row of schedule, S.xls
j = 2 ' First job row of Plate & Bar Spreadsheet
Do Until CDate(GetDate(GetValue(sSchedPath, "schedule, S.xls", "LOG (2)", "N" & CStr(l)))) >= dteStart
l = l + 1
' Changed from 754 to 854...may be total jobs for year...went close to 800 jobs this year . BAW
If l = 854 Then
MsgBox ("Hello")
End If
sTmp = Trim$(GetValue(sSchedPath, "schedule, S.xls", "LOG (2)", "N" & CStr(l)))
If sTmp = "0" Or Len(sTmp) = 0 Or sTmp = "HOLIDAY" Then
l = l + 1
End If
Loop
Do
sJob = ParseJob(GetValue(sSchedPath, "schedule, S.xls", "LOG (2)", "B" & CStr(l)))
' Debug.Print sJob
vJobFolders = Split(FindJobDir(strpathtofile & sJob), ",")
For i = 0 To UBound(vJobFolders)
On Error GoTo ErrorExit
Application.Sheets("report").Range("C" & CStr(j)).Value = vJobFolders(i)
j = j + 1
file_in = FreeFile 'file number
strFileToOpen = strpathtofile & vJobFolders(i) & strFilename
If Dir(strFileToOpen) <> "" Then
Open strFileToOpen For Input As #file_in
Put_Data_In_Array (file_in)
Organize_Array_For_Print
Close #file_in ' close the file
End If
ErrorExit:
Next i
l = l + 1
sTmp = Trim$(GetValue(sSchedPath, "schedule, S.xls", "LOG (2)", "N" & CStr(l)))
If sTmp = "0" Or Len(sTmp) = 0 Or sTmp = "HOLIDAY" Then
l = l + 1
End If
Loop Until CDate(GetDate(sTmp)) >= dteEnd
Sheets("REPORT").Select

End Sub

Function GetValue(path, file, sheet, ref) As String
' Retrieves a value from a closed workbook
Dim arg As String
Dim pos As Integer
' Make sure the file exists
If Right(path, 1) <> "" Then path = path & ""
If Dir(path & file) = "" Then
GetValue = "File Not Found"
Exit Function
End If
' Create the argument
arg = "'" & path & "[" & file & "]" & sheet & "'!" & _
Range(ref).Range("A1").Address(, , xlR1C1)
' Execute an XLM macro
GetValue = ExecuteExcel4Macro(arg)
' Strip Any time from beginning of Date string
pos = InStr(GetValue, ":")
If pos <> 0 Then GetValue = Mid$(GetValue, pos + 3)
End Function

只是不知道如何告诉它,使用VBA,将每个作业编号放在W列中并按照通常的方式执行另一种操作,然后如果它不完全匹配则发出警告,并在停止时停止它教一个空单元格。

有关在何处查找此示例的任何建议?如果我能让这一部分继续下去,我相当自信我可以做其余的事情。如果需要,我可以发布现有的子程序代码。我认为这比我想象的要容易得多。现在只需要来自W列的数据,然后它应该输入其余的数组并生成所需的数据。

我收到了关于如何将这个数据库作为数据库的提示,但我现在还没有这种奢侈品。

0 个答案:

没有答案