Файл приложен
Стоит задача создать процедуру, которая присваивает переменным (название которых совпадает с тегом) значение номера колонки в которой стоит данный тег.
См. скриншот и код. Вместо многих переменных - один объект oTags As Collection.
Sub Main
Dim oTags As New Collection
Dim sh, rgs, rg, cell
Dim j&, item, s$
Dim arr()
'arr() = Array("gid", "adress", "spl" _
' , "m0", "m1", "m2", "m3", "m4", "m5", "m6", "m7", "m8", "m9", "m10", "m11" _
' , "price1", "price2", "price3", "price4", "price5", "photo1", "photo2", "photo3")
sh = ThisComponent.Sheets(0)
rg = sh.getCellRangeByPosition(0, 3, 22, 3)
arr() = rg.DataArray
'For j = 0 To 22
' cell = sh.getCellByPosition(j, 3)
' oColumnHeaders.Add cell.CellAddress.Column, cell.String
'Next
rgs = ThisComponent.createInstance("com.sun.star.sheet.SheetCellRanges")
rgs.addRangeAddress(rg.RangeAddress, False)
For Each cell In rgs.Cells
oTags.Add cell.CellAddress.Column, cell.String
Next
s = "Tag Count: " & oTags.Count & Chr(10)
For Each item In oTags
s = s & " " & item
Next
MsgBox s, , "Column Indices"
MsgBox arr(0)(0) & " = " & oTags(arr(0)(0)), , "Example"
s = "Tag Count: " & oTags.Count & Chr(10)
For Each item In arr(0)
s = s & Chr(10) & item & " = " & oTags(item)
Next
MsgBox s, , "Extract column index from Collection by Tag"
End Sub
Прим. В отличие от CellRange
s CellRange не содержит свойства Cells. Удобно для перебора ячеек в цикле For Each, причём:
For Each cell In rgs.Cells
автоматически пропускает пустые ячейки (только Used cells).