简体   繁体   中英

Loop through excel-spreadsheet-rows until empty using VBA-macro in powerpoint. For each row read values and write to 2-dim-array. No .select

I wanna do a simple search and replace in powerpoint.

I am trying to loop through an excel spreadsheet using a VBA-macro in powerpoint. The spreadsheet has two columns and ~100 rows. I want the macro to loop through the rows until it reaches an empty cell. For each row it shell read the values of column 1 and column 2 and write those to an 2-dimensional-array.

I had it running using various .select-statements but I didn't like it that way (is select buggy? Search and replace worked a few times, but after changing the spreadsheet too often the macro always crashed). I am trying to use a more robust way with better performance.

Dim excelDataArray(120, 2) As String

Dim slidedeck As Presentation
Set slidedeck = ActivePresentation

Dim singleslide As Slide

Dim excelFile As Excel.Workbook
Set excelFile = Excel.Application.Workbooks.Open(spreadsheetFolder)
Dim excelSheet As Excel.Worksheet
Set excelSheet = excelFile.Worksheets("Sheet1")

'Loop through each row in Column A until empty row
Dim N As Integer
N = excelSheet.Cells(excelSheet.Rows.Count, "A").End(xlUp).Row
For i = 1 To N
    excelDataArray(i, 0) = excelSheet.Cells(i, "A").Value
    excelDataArray(i, 1) = excelSheet.Cells(i, "B").Value
Next

You can dump it directly to a variant array without loops.

I have tidied your variables for completeness.

Pls change the path to your xl file here, "C:\\temp\\test.xlsx"

Sub likethis()

Dim slidedeck As Presentation

Dim singleslide As Slide
Dim XLS As Excel.Application
Dim excelFile As Excel.Workbook
Dim excelSheet As Excel.Worksheet

Dim lngROw As Long
Dim X

Set slidedeck = ActivePresentation
Set XLS = New Excel.Application    
Set excelFile = XLS.Workbooks.Open("C:\temp\test.xlsx")
Set excelSheet = excelFile.Worksheets("Sheet1")

lngROw = excelSheet.Cells(excelSheet.Rows.Count, "A").End(xlUp).Row
ReDim X(1 To lngROw, 1 To 2)
X = excelSheet.Range("A1:B" & lngROw)
End Sub

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM