Question

我每次点击按钮时都试图用图表实现自动更新数据。该函数位于for循环内，并将执行以从另一个工作簿获取数据。成功获取数据后，将创建图表，但图表仅在完成所有循环完成后创建。有没有其他方法可以做到这一点？每个循环都会更新数据和图表。在另一个工作簿上查看的图表。

这是我的代码

Sub LiveUpdate_Button1_Click()
Dim x As Long
For x = 0 To 10
Application.Wait (Now + TimeValue("0:00:5"))
Call Data_1
Call Data_2
Call Data_3
Next x

'Call SingleClick
  ActiveWorkbook.RefreshAll
Workbooks("graph.xlsx").RefreshAll
End Sub

Data_1 - Data_3目前只有不同范围的相同代码。

Sub Data_3()
Dim x As Long
'For x = 0 To 10
Dim iLast As Long
Dim i As Long, j As Long
Dim targetlastrow As Long, sourcelstrow As Long
Dim Sourcelastcol As Long
Dim source As Worksheet
Dim target As Worksheet
Dim InputRng As Range
Dim OutRng As Range
Dim xRow As Integer
Dim count As Integer
Dim count1 As Integer
Dim test As String
Dim LookupWB As Workbook
Dim pth As String
Dim pth2 As String
Dim pth3 As String
Dim lotNo As String
Dim field As String
ThisWorkbook.Sheets("LiveUpdate").Activate
Range("AH16", "AK25").ClearContents
Range("AF123", "AI162").ClearContents
Range("AK123", "AM162").ClearContents


 pth = Sheets("LiveUpdate").Cells(1, 3).Value 'Select folder path
 pth2 = Sheets("LiveUpdate").Cells(1, 4).Value 'Select file path
 pth3 = "=LEFT(D1, LEN(D1)-25)"  'Trim to obtain Item Type
 Sheets("LiveUpdate").Cells(1, 5).Value = pth3
 Sheets("LiveUpdate").Cells(16, 5).Value = "=RIGHT((LEFT(D1, LEN(D1)-4)), LEN(LEFT(D1, LEN(D1)-4))-18)"



'Set LookupWB = Workbooks.Open(Filename:=pth)
Set source = Workbooks(pth2).Sheets(1)
Set target = Workbooks("New Microsoft Excel Worksheet").Sheets("LiveUpdate")

field = target.Cells(9, 39) 'Select field
'source.Activate

ThisWorkbook.Sheets("LiveUpdate").Activate
iLast = source.Range("A" & Rows.count).End(xlUp).Row
Set InputRng = source.Range(field & iLast - 60 & ":" & field & iLast) 'Which field data to take
Set InputRng = InputRng.Columns(1)
Set ConRng = source.Range("C2:C" & iLast) 'Condition
Set ConRng = ConRng.Columns(1)
Set DateRng = source.Range("D2:E2") 'Date
Set DateRng = DateRng.Columns(1)
Set DateRng1 = DateRng.Columns(2)

'To set number of row with pass value
For i = 1 To iLast
        xValue = InputRng.Cells(i + 1)
        xCon = ConRng.Cells(i + 1)
        If xCon = "PASS" And Not IsEmpty(xValue) Then
        count1 = count1 + 1
        End If
    Next i

'target.Cells(12, 11) = (count1 / iLast) * 100
'target.Cells(13, 11) = 100 - target.Cells(12, 11).Value
Set OutRng = target.Range("$AH$16") 'Field to view output

xDate = DateRng.Cells(1)
xTime = DateRng1.Cells(1)
Sheets("LiveUpdate").Cells(16, 31).Value = xDate
Sheets("LiveUpdate").Cells(16, 32).Value = xTime

xCol = 4  ' To set how many row per item
k = 0
xRow = 10

'ReDim xArr(1 To xRow, 1 To xRow + 1)
ReDim xArr(1 To xRow + 1, 1 To xCol)
    For i = 0 To InputRng.Cells.count - 1
        xValue = InputRng.Cells(i + 1)
        xCon = ConRng.Cells(i + 1)
        If xCon = "PASS" And k <= 39 And Not IsEmpty(xValue) Then
            iCol = k Mod xCol
            iRow = VBA.Int(k / xCol)
            xArr(iRow + 1, iCol + 1) = xValue
            count = count + 1
        Else
            k = k - 1
        End If
        k = k + 1
    Next
    OutRng.Resize(UBound(xArr, 1), UBound(xArr, 2)).Value = xArr

Range("AF123", "AF" & (123 + xRow - 1)).Value = target.Cells(28, 35) 'to copy all value from G302
Range("AG123", "AG" & (123 + xRow - 1)).Value = target.Cells(28, 36) 'to copy all value from H302
Range("AH123", "AH" & (123 + xRow - 1)).Value = target.Cells(28, 37) 'to copy all value from I302
Range("AK123", "AK" & (123 + xRow - 1)).Value = target.Cells(29, 35) 'to copy all value from G303
Range("AL123", "AL" & (123 + xRow - 1)).Value = target.Cells(29, 36) 'to copy all value from H303


For i = 0 To xRow - 1
    target.Cells(123 + i, 35) = target.Cells(16 + i, 38) 'to copy all value from J16
    target.Cells(123 + i, 39) = target.Cells(16 + i, 39) 'to copy all value from K16
Next i
source.Activate
ActiveWorkbook.Close SaveChanges:=False
End Sub

更新每个for循环的图表

0 个答案: