This is a row of cCell . The sid argument refers to the column either by column name or number. Where sid optional and omitted the complete row is operated on. Where sid is present the cCell it addresses in the cDataRow is operated on.
For example
cDataRow.Refresh() will refresh the entire row and cDataRow.cell("London").Refresh() will refresh a specific cell. cDataRow.refresh() is equivalent to cDataSet.row("some rowid").refresh()
You can find the methods and properties documentation on github and the source colde below or on Github
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 |
'gistThat@mcpher.com :do not modify this line - see ramblings.mcpher.com for details: updated on 8/18/2014 4:47:43 PM : from manifest:3414394 gist https://gist.github.com/brucemcpherson/3414216/raw/cDataRow.cls ' a collection of data Cells representing one row of data Option Explicit 'v 2.02 'for more about this ' https://ramblings.mcpher.com/classes/data-manipulation-classes 'to contact me ' http://groups.google.com/group/excel-ramblings 'reuse of code ' https://ramblings.mcpher.com/codeuse Private pCollect As Collection ' a collection of data Cells - one for every column in this row Private pWhere As Range Private pParent As cDataSet Private pRow As Long Private pHidden As Boolean Public Property Get hidden() hidden = pHidden End Property Public Property Get parent() As cDataSet Set parent = pParent End Property Public Property Get row() As Long row = pRow End Property Public Property Get columns() As Collection Set columns = pCollect End Property Public Property Get where() As Range Set where = pWhere End Property Public Property Get cell(sid As Variant, Optional complain As Boolean = False) As cCell Dim c As cCell Set c = exists(sid) If c Is Nothing And complain Then MsgBox (CStr(sid) & " is not a known column heading") End If Set cell = c End Property Public Property Get value(sid As Variant) As Variant Dim cc As cCell Set cc = cell(sid) If Not cc Is Nothing Then value = cc.value End If End Property Public Property Get values(Optional bIncludeKey = False) As Variant Dim cc As cCell ReDim a(1 To columns.count) As Variant For Each cc In columns If cc.column <> pParent.keyColumn Or bIncludeKey Then a(cc.column) = cc.value Else a(cc.column) = Empty End If Next cc values = a End Property Public Function find(v As Variant, Optional bIncludeKey = False) As cCell Dim cc As cCell For Each cc In columns If cc.column <> pParent.keyColumn Or bIncludeKey Then If makeKey(cc.value) = makeKey(v) Then Set find = cc Exit Function End If End If Next cc End Function Public Function max(Optional bIncludeKey = False) As Variant max = Application.WorksheetFunction.max(values(bIncludeKey)) End Function Public Function min(Optional bIncludeKey = False) As Variant max = Application.WorksheetFunction.min(values(bIncludeKey)) End Function Public Function refresh(Optional sid As Variant) As Variant Dim dt As cCell, v As Variant If IsMissing(sid) Then For Each dt In columns v = dt.refresh Next dt Else refresh = cell(sid).refresh End If End Function Public Sub Commit(Optional p As Variant, Optional sid As Variant) Dim dt As cCell If IsMissing(sid) Then For Each dt In columns dt.Commit p Next dt Else cell(sid).Commit p End If End Sub Public Property Get toString(sid As Variant, Optional sFormat As String = vbNullString) As String toString = cell(sid).toString(sFormat) End Property Public Function create(dset As cDataSet, rDataRow As Range, nRow As Long, _ rv As Variant) As cDataRow Dim rCell As Range, dcell As cCell, hcell As cCell, hr As cHeadingRow, n As Long Dim r As Range, dc As cDataColumn Set pWhere = rDataRow Set pParent = dset pRow = nRow n = 0 ' recordfilter pHidden = False If (pParent.recordFilter) Then pHidden = rDataRow.EntireRow.hidden End If If pRow = 0 Then ' we are doing a headingrow For Each r In pWhere.Cells n = n + 1 If IsEmpty(r) Then MsgBox ("unexpected blank heading cell at " & SAd(r)) Exit Function End If Debug.Assert Not IsEmpty(r) Set dcell = New cCell With dcell pCollect.add .create(Me, n, r), makeKey(CStr(r.value)) End With Next r Else Set hr = pParent.headingRow For Each hcell In hr.headings ' create a cell to hold it in Set rCell = rDataRow.Cells(1, hcell.column) Set dcell = New cCell dcell.create Me, hcell.column, rCell, rv(nRow - 1 + LBound(rv, 1), hcell.column - 1 + LBound(rv, 2)) pCollect.add dcell ' set the type of column Set dc = pParent.columns(hcell.column) With dc If Not IsEmpty(rCell) Then If .typeofColumn <> eTCmixed Then If IsDate(rCell.value) Then If .typeofColumn <> eTCdate Then If .typeofColumn = eTCunknown Then .typeofColumn = eTCdate Else .typeofColumn = eTCmixed End If End If ElseIf IsNumeric(rCell.value) Then If .typeofColumn <> eTCnumeric Then If .typeofColumn = eTCunknown Then .typeofColumn = eTCnumeric Else .typeofColumn = eTCmixed End If End If Else If .typeofColumn <> eTCtext Then If .typeofColumn = eTCunknown Then .typeofColumn = eTCtext Else .typeofColumn = eTCmixed End If End If End If End If End If End With Next hcell End If Set create = Me End Function Private Function exists(sid As Variant) As cCell On Error GoTo handle If VarType(sid) = vbLong Or VarType(sid) = vbInteger Then Set exists = pCollect(sid) Else Set exists = pCollect(pParent.headings(makeKey(CStr(sid))).column) End If Exit Function handle: Set exists = Nothing End Function Public Sub tearDown() ' clean up Dim cc As cCell If Not pCollect Is Nothing Then For Each cc In columns cc.tearDown Next cc Set pCollect = Nothing End If Set pParent = Nothing End Sub Private Sub Class_Initialize() Set pCollect = New Collection End Sub |