Skip to content

Instantly share code, notes, and snippets.

@TheCrazyT
Created January 25, 2011 10:02
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save TheCrazyT/794738 to your computer and use it in GitHub Desktop.
Save TheCrazyT/794738 to your computer and use it in GitHub Desktop.
Importfunktion für DSO_Economic
Option Explicit
Private Function GetRow(name As String)
Select Case name
Case "Forester": GetRow = 22: Exit Function
Case "WoodCutter": GetRow = 25: Exit Function
Case "Sawmill": GetRow = 28: Exit Function
Case "Mason": GetRow = 31: Exit Function
Case "Fisher": GetRow = 34: Exit Function
Case "CoalMine": GetRow = 37: Exit Function
Case "CokingPlant": GetRow = 40: Exit Function
Case "BronzeMine": GetRow = 43: Exit Function
Case "BronzeSmelter": GetRow = 46: Exit Function
Case "Toolmaker": GetRow = 49: Exit Function
Case "Well": GetRow = 52: Exit Function
Case "Farm": GetRow = 55: Exit Function
Case "Brewery": GetRow = 58: Exit Function
Case "Miller": GetRow = 61: Exit Function
Case "Bakery": GetRow = 64: Exit Function
Case "BronzeWeaponsmith": GetRow = 67: Exit Function
Case "Bowmaker": GetRow = 70: Exit Function
Case "RealWoodForester": GetRow = 73: Exit Function
Case "RealWoodCutter": GetRow = 76: Exit Function
Case "RealWoodSawmill": GetRow = 79: Exit Function
Case "IronMine": GetRow = 82: Exit Function
Case "IronSmelter": GetRow = 85: Exit Function
Case "SteelForge": GetRow = 88: Exit Function
Case "Goldmine": GetRow = 91: Exit Function
Case "GoldSmelter": GetRow = 94: Exit Function
Case "Coinage": GetRow = 97: Exit Function
Case "MarbleMason": GetRow = 100: Exit Function
Case "Hunter": GetRow = 103: Exit Function
Case "Butcher": GetRow = 106: Exit Function
Case "Stable": GetRow = 109: Exit Function
Case "IronWeaponsmith": GetRow = 112: Exit Function
Case "SteelWeaponsmith": GetRow = 115: Exit Function
Case "Longbowmaker": GetRow = 118: Exit Function
End Select
GetRow = -1
End Function
Private Function GetRow2(name As String)
Select Case name
Case "SimpleResidence": GetRow2 = 11: Exit Function
Case "NobleResidence": GetRow2 = 14: Exit Function
Case "Warehouse": GetRow2 = 17: Exit Function
End Select
GetRow2 = -1
End Function
Public Sub Import()
Dim MyDataObject As New DataObject
Dim Clip As String
Dim Lines() As String
Dim Line As Variant
Dim Cols() As String
Dim a As Integer
Dim Row As Integer
Dim ColSteps(200) As Integer
Worksheets("Produktionseinrichtungen").Range("D22:AI120").Value = "" 'Tabelle für Produktion leeren
'Tabelle für Wohnhäuser und Lager leeren
Worksheets("Produktionseinrichtungen").Range("D11:AI11").Value = ""
Worksheets("Produktionseinrichtungen").Range("D14:AI14").Value = ""
Worksheets("Produktionseinrichtungen").Range("D17:AI17").Value = ""
MyDataObject.GetFromClipboard
Clip = MyDataObject.GetText
Lines = Split(Clip, vbNewLine)
For a = 0 To 200
ColSteps(a) = 0
Next
'Produktionstabelle füllen
For Each Line In Lines
If (Line <> "") Then
Cols = Split(Line, ",")
Row = GetRow(Cols(0))
If Row <> -1 Then
Worksheets("Produktionseinrichtungen").Cells(Row, 4 + ColSteps(Row)).Value = Cols(1) / 60 'Produktionszeit
Worksheets("Produktionseinrichtungen").Cells(Row + 1, 4 + ColSteps(Row)).Value = Cols(2) 'Level
If (Cols(3) = 1) Then 'Aktiv?
Worksheets("Produktionseinrichtungen").Cells(Row + 2, 4 + ColSteps(Row)).Value = "JA"
Else
Worksheets("Produktionseinrichtungen").Cells(Row + 2, 4 + ColSteps(Row)).Value = "NEIN"
End If
ColSteps(Row) = ColSteps(Row) + 1
End If
End If
Next
'Tabelle für Wohnhäuser füllen
For Each Line In Lines
If (Line <> "") Then
Cols = Split(Line, ",")
Row = GetRow2(Cols(0))
If Row <> -1 Then
Worksheets("Produktionseinrichtungen").Cells(Row, 4 + ColSteps(Row)).Value = Cols(2) 'Level
ColSteps(Row) = ColSteps(Row) + 1
End If
End If
Next
End Sub
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment