Here is the standard module modStaticValuesScriptGenerator.bas It relies on tables of data being resident on sheets Players and Clubs. To solve chicken and egg problem, a script below follows which you can use first...
Attribute VB_Name = "modStaticValuesScriptGenerator"
Option Explicit
Sub TestGenerateScript()
Dim dicScript As Scripting.Dictionary
GenerateScript dicScript, "Players"
GenerateScript dicScript, "Clubs"
Debug.Print Join(dicScript.items, vbNewLine)
End Sub
Function GenerateScript(ByRef dicLines As Scripting.Dictionary, ByVal sSheetName As String) As Variant
If dicLines Is Nothing Then Set dicLines = New Scripting.Dictionary
'Debug.Assert sSheetName > 1
Dim wsData As Excel.Worksheet
Set wsData = ThisWorkbook.Worksheets.Item(sSheetName)
Dim rngData As Excel.Range
Set rngData = wsData.Cells(1, 1).CurrentRegion
Dim lRowCount As Long
lRowCount = rngData.Rows.Count
Dim lColumnCount As Long
lColumnCount = rngData.Columns.Count
ReDim sRow(1 To lRowCount) As String
Dim lRowLoop As Long
For lRowLoop = 1 To lRowCount
sRow(lRowLoop) = ""
Dim lColumnLoop As Long
For lColumnLoop = 1 To lColumnCount
Dim rng As Excel.Range
Set rng = rngData.Cells(lRowLoop, lColumnLoop)
Dim v As Variant
v = rng.Value2
Dim v2 As Variant: v2 = Empty
If IsNumeric(v) Then
v2 = v
Else
v2 = """" & v & """"
End If
sRow(lRowLoop) = sRow(lRowLoop) & VBA.IIf(Len(sRow(lRowLoop)) = 0, v2, "," & v2)
Next lColumnLoop
Next lRowLoop
' Stop
Dim lRowsPerChunk As Long
lRowsPerChunk = 5
If lRowCount Mod lRowsPerChunk = 1 Then
'* no singleton rows because we need tweo dimensional chunks
'* so add a blank line
ReDim Preserve sRow(LBound(sRow) To UBound(sRow) + 1)
Dim sPad As String: sPad = ""
'Dim lPadLoop As Long
For lColumnLoop = 1 To lColumnCount
sPad = sPad & VBA.IIf(Len(sPad) > 0, ",""""", """""")
Next
sRow(UBound(sRow)) = sPad
lRowCount = lRowCount + 1
End If
Dim lChunks As Long
lChunks = Int(lRowCount / lRowsPerChunk) + 1
ReDim sChunks(1 To lChunks) As String
ReDim sRow2(1 To lRowsPerChunk) As String
'sData = ""
For lRowLoop = 1 To lRowCount
Dim lChunk As Long
lChunk = ((lRowLoop - 1) \ lRowsPerChunk) + 1
Debug.Assert lChunk <> 0
Dim lChunkRow As Long
lChunkRow = (lRowLoop Mod lRowsPerChunk)
Dim lChunkRowIndex As Long
lChunkRowIndex = VBA.IIf(lChunkRow = 0, lRowsPerChunk, lChunkRow)
sRow2(lChunkRowIndex) = sRow(lRowLoop)
If lRowLoop Mod lRowsPerChunk = 0 Then
Debug.Assert sChunks(lChunk) = ""
sChunks(lChunk) = "[{" & VBA.Join(sRow2, ";") & "}]"
ReDim sRow2(1 To lRowsPerChunk) As String
End If
Next
ReDim Preserve sRow2(1 To lChunkRowIndex)
sChunks(lChunks) = "[{" & VBA.Join(sRow2, ";") & "}]"
dicLines.Add dicLines.Count, "Sub Paste" & sSheetName
dicLines.Add dicLines.Count, vbTab & "Dim sh as Excel.Worksheet: Set sh=Nothing" & vbNewLine
dicLines.Add dicLines.Count, vbTab & "Dim v(1 to " & lChunks & ") as Variant"
Dim lChunkLoop As Long
For lChunkLoop = 1 To lChunks
dicLines.Add dicLines.Count, vbTab & "v(" & lChunkLoop & ")=" & sChunks(lChunkLoop)
Next
dicLines.Add dicLines.Count, vbTab & "Dim lRowIndex As Long: lRowIndex = 0"
dicLines.Add dicLines.Count, vbTab & "Dim lChunkLoop As Long"
dicLines.Add dicLines.Count, vbTab & "For lChunkLoop = 1 To " & lChunks
dicLines.Add dicLines.Count, vbTab & " Dim vWrite As Variant"
dicLines.Add dicLines.Count, vbTab & " vWrite = v(lChunkLoop)"
dicLines.Add dicLines.Count, vbTab & " Dim lChunkRowsCount As Long"
dicLines.Add dicLines.Count, vbTab & " lChunkRowsCount = UBound(vWrite, 1) - LBound(vWrite, 1) + 1"
dicLines.Add dicLines.Count, vbTab & " sh.Cells(1, 1).Offset(lRowIndex).Resize(lChunkRowsCount, UBound(vWrite, 2) - LBound(vWrite, 2) + 1).Value2 = vWrite"
dicLines.Add dicLines.Count, vbTab & " lRowIndex = lRowIndex + lChunkRowsCount"
dicLines.Add dicLines.Count, vbTab & "Next"
dicLines.Add dicLines.Count, "End Sub "
End Function
Here is the standard module modScripts.bas It was generated by module above
Attribute VB_Name = "modScripts"
Sub PastePlayers()
Dim sh As Excel.Worksheet: Set sh = Sheet10
Dim v(1 To 5) As Variant
v(1) = [{"Player","Club","Nationality","Goals";"Diego Costa","Chelsea","Spain",15;"Alexis Sánchez","Arsenal","Chile",15;"Jermain Defoe","Sunderland","England",14;"Zlatan Ibrahimovic","Manchester United","Sweden",14}]
v(2) = [{"Romelu Lukaku","Everton","Belgium",14;"Harry Kane","Tottenham Hotspur","England",13;"Sergio Agüero","Manchester City","Argentina",11;"Dele Alli","Tottenham Hotspur","England",11;"Eden Hazard","Chelsea","Belgium",10}]
v(3) = [{"Christian Benteke","Crystal Palace","Belgium",9;"Sadio Mané","Liverpool","Senegal",9;"Michail Antonio","West Ham United","England",8;"Roberto Firmino","Liverpool","Brazil",8;"Olivier Giroud","Arsenal","France",8}]
v(4) = [{"Fernando Llorente","Swansea City","Spain",8;"Theo Walcott","Arsenal","England",8;"Troy Deeney","Watford","England",7;"Adam Lallana","Liverpool","England",7;"Salomón Rondón","West Bromwich Albion","Venezuela",7}]
v(5) = [{"Gylfi Sigurdsson","Swansea City","Iceland",7;"","","",""}]
Dim lRowIndex As Long: lRowIndex = 0
Dim lChunkLoop As Long
For lChunkLoop = 1 To 5
Dim vWrite As Variant
vWrite = v(lChunkLoop)
Dim lChunkRowsCount As Long
lChunkRowsCount = UBound(vWrite, 1) - LBound(vWrite, 1) + 1
sh.Cells(1, 1).Offset(lRowIndex).Resize(lChunkRowsCount, UBound(vWrite, 2) - LBound(vWrite, 2) + 1).Value2 = vWrite
lRowIndex = lRowIndex + lChunkRowsCount
Next
End Sub
Sub PasteClubs()
Dim sh As Excel.Worksheet: Set sh = Sheet9
Dim v(1 To 5) As Variant
v(1) = [{"Club","Wins";"Chelsea",19;"Arsenal",14;"Manchester City",14;"Liverpool",13}]
v(2) = [{"Tottenham Hotspur",13;"Manchester United",11;"Everton",10;"Burnley",9;"West Bromwich Albion",9}]
v(3) = [{"West Ham United",8;"AFC Bournemouth",7;"Southampton",7;"Stoke City",7;"Watford",7}]
v(4) = [{"Swansea City",6;"Crystal Palace",5;"Leicester City",5;"Hull City",4;"Middlesbrough",4}]
v(5) = [{"Sunderland",4;"",""}]
Dim lRowIndex As Long: lRowIndex = 0
Dim lChunkLoop As Long
For lChunkLoop = 1 To 5
Dim vWrite As Variant
vWrite = v(lChunkLoop)
Dim lChunkRowsCount As Long
lChunkRowsCount = UBound(vWrite, 1) - LBound(vWrite, 1) + 1
sh.Cells(1, 1).Offset(lRowIndex).Resize(lChunkRowsCount, UBound(vWrite, 2) - LBound(vWrite, 2) + 1).Value2 = vWrite
lRowIndex = lRowIndex + lChunkRowsCount
Next
End Sub
No comments:
Post a Comment