工具vba

由于我组的teamleader忙不过来了， 今天manager把我们组分成2个小组，让我先带一组，突然袭击呀，赶紧把工具贴出来明天给同事分享（不然又要加班了）， 没有什么时候考虑代码优化了，能用就可以了。

 

Const TableSpace As Integer = 3

Private Sub CommandButton1_Click()
Call setTableData
End Sub

Sub setTableData()

Dim intFromColumn As Integer
Dim intFromRow As Integer
Dim intFlagTableColumn As Integer
Dim intToTableColumn As Integer

intFromColumn = 2
intFromRow = 2
intFlagTableColumn = 1
intToTableColumn = 6

Dim strFromColumnName As String
Dim strTableName As String
Dim strToTableName As String
Dim strFlag As String
Dim strValue As String
Dim strToColumn As String

strToTableName = Sheets("template").Cells(2, intToTableColumn).Value

Do While True

strFromColumnName = Sheets("template").Cells(intFromRow, intFromColumn).Value
strFlag = Sheets("template").Cells(intFromRow, intFlagTableColumn).Value
strToColumn = Sheets("template").Cells(intFromRow, intToTableColumn).Value

If strFlag = "True" Then
    strTableName = strFromColumnName
    Else
    strValue = getData(strTableName, strFromColumnName)
    If InStr(strValue, "is no") > 1 Then
         Call setData(strToTableName, strToColumn, strValue)
         Exit Do
    End If
    strValue = setData(strToTableName, strToColumn, strValue)
   
End If

intFromRow = intFromRow + 1
If intFromRow > 1000 Then
     Exit Do
End If

Loop

End Sub

Function getData(ByVal strTableName As String, ByVal strColumnName) As String

Dim intTableRow As Integer
Dim intColumn As Integer
Dim strColumn As String
Dim strTName As String
Dim intScanColumn As Integer
   
    intColumn = 3
    intTableRow = 1
   
Do While True

strTName = Sheets("FromTable").Cells(intTableRow, intColumn).Value
If strTableName = strTName Then
    Exit Do
End If
intTableRow = intTableRow + 1
If intTableRow > 500 Then
     getData = "there is no table" + strTableName
     Exit Do
End If

Loop

intScanColumn = 4
Do While True

strColumn = Sheets("FromTable").Cells(intTableRow + TableSpace, intScanColumn).Value
If strColumn = strColumnName Then
    getData = Sheets("FromTable").Cells(intTableRow + TableSpace + 1, intScanColumn).Value
    Exit Do
End If
intScanColumn = intScanColumn + 1
If intScanColumn > 255 Then
    getData = "there is no column" + strColumnName
     Exit Do
End If

Loop

End Function

Function setData(ByVal strTableName As String, ByVal strColumnName, ByVal strValue As String) As String

Dim intTableRow As Integer
Dim intColumn As Integer
Dim strColumn As String
Dim strTName As String
Dim intScanColumn As Integer
   
    intColumn = 3
    intTableRow = 1
   
Do While True

strTName = Sheets("ToTable").Cells(intTableRow, intColumn).Value
If strTableName = strTName Then
    Exit Do
End If
intTableRow = intTableRow + 1
If intTableRow > 500 Then
    setData = "there is no table" + strTableName
    Exit Do
End If

Loop

intScanColumn = 4
Do While True

strColumn = Sheets("ToTable").Cells(intTableRow + TableSpace, intScanColumn).Value
If strColumn = strColumnName Then
     Sheets("ToTable").Cells(intTableRow + TableSpace + 1, intScanColumn).Value = strValue
    Exit Do
End If
intScanColumn = intScanColumn + 1
If intScanColumn > 255 Then
    setData = "there is no column" + strColumnName
    Exit Do
End If

Loop

End Function

Private Sub CommandButton2_Click()

'check column
'clear backcolor
 Sheets("template").Range("B2:B500").Select
 Selection.Interior.ColorIndex = xlNone
 Sheets("template").Range("F2:F500").Select
 Selection.Interior.ColorIndex = xlNone
 Sheets("FromTable").Select
 Sheets("FromTable").Cells.Select
 Selection.Interior.ColorIndex = 2
 
 Call checkColumn
 Sheets("template").Select

End Sub

 

Sub checkColumn()

Dim intFromColumn As Integer
Dim intFromRow As Integer
Dim intFlagTableColumn As Integer
Dim intToTableColumn As Integer

intFromColumn = 2
intFromRow = 2
intFlagTableColumn = 1
intToTableColumn = 6

Dim strFromColumnName As String
Dim strTableName As String
Dim strToTableName As String
Dim strFlag As String
Dim strValue As String
Dim strToColumn As String
Dim blFlag As Boolean

strToTableName = Sheets("template").Cells(2, intToTableColumn).Value

Do While True

strFromColumnName = Sheets("template").Cells(intFromRow, intFromColumn).Value
strFlag = Sheets("template").Cells(intFromRow, intFlagTableColumn).Value
strToColumn = Sheets("template").Cells(intFromRow, intToTableColumn).Value

If strFlag = "True" Then
    strTableName = strFromColumnName
    Else
   
    blFlag = IsColumnExist("FromTable", strTableName, strFromColumnName)
   
    If blFlag = False Then
        Sheets("template").Select
        Sheets("template").Cells(intFromRow, intFromColumn).Select
        Selection.Interior.ColorIndex = 3
    End If
   
    blFlag = IsColumnExist("ToTable", strToTableName, strToColumn)
   
    If blFlag = False Then
        Sheets("template").Cells(intFromRow, intToTableColumn).Select
        Selection.Interior.ColorIndex = 3
    End If
   
End If

intFromRow = intFromRow + 1
If intFromRow > 500 Then
     Exit Do
End If

Loop

End Sub

Function IsColumnExist(ByVal strSheetName As String, ByVal strTableName As String, ByVal strColumnName) As Boolean

Dim intTableRow As Integer
Dim intColumn As Integer
Dim strColumn As String
Dim strTName As String
Dim intScanColumn As Integer
   
    intColumn = 3
    intTableRow = 1
   
    IsColumnExist = False
   
Do While True

strTName = Sheets(strSheetName).Cells(intTableRow, intColumn).Value
If strTableName = strTName Then
    Exit Do
End If

intTableRow = intTableRow + 1
If intTableRow > 500 Then
     Exit Do
End If

Loop

intScanColumn = 4
Do While True

strColumn = Sheets(strSheetName).Cells(intTableRow + TableSpace, intScanColumn).Value
If strColumn = strColumnName Then
    IsColumnExist = True
    If strSheetName = "FromTable" And strColumn <> "" Then
        Sheets(strSheetName).Select
        Sheets(strSheetName).Cells(intTableRow + TableSpace, intScanColumn).Select
        Selection.Interior.ColorIndex = 4
        Sheets(strSheetName).Cells(intTableRow + TableSpace + 1, intScanColumn).Select
        Selection.Interior.ColorIndex = 4
        Sheets(strSheetName).Cells(intTableRow + TableSpace + 2, intScanColumn).Select
        Selection.Interior.ColorIndex = 4
       
    End If
    Exit Do
End If

intScanColumn = intScanColumn + 1
If intScanColumn > 255 Then
     Exit Do
End If

Loop

End Function
Private Sub CommandButton3_Click()
Call comparetable
End Sub

Sub comparetable()

Dim intFromColumn As Integer
Dim intFromRow As Integer
Dim intFlagTableColumn As Integer
Dim intToTableColumn As Integer

intFromColumn = 2
intFromRow = 2
intFlagTableColumn = 1
intToTableColumn = 6

Dim strFromColumnName As String
Dim strTableName As String
Dim strToTableName As String
Dim strFlag As String
Dim strValue As String
Dim strToColumn As String
Dim blFlag As Boolean

strToTableName = Sheets("template").Cells(2, intToTableColumn).Value

Dim intFromX As Integer
Dim intFromY As Integer

Do While True

strFromColumnName = Sheets("template").Cells(intFromRow, intFromColumn).Value
strFlag = Sheets("template").Cells(intFromRow, intFlagTableColumn).Value
strToColumn = Sheets("template").Cells(intFromRow, intToTableColumn).Value

If strFlag = "True" Then
    strTableName = strFromColumnName
    Else
   
    Call getFromXY(strTableName, strFromColumnName, intFromX, intFromY)
   
    If intFromX > 0 Then
        Call setToXY(strToTableName, strToColumn, intFromX, intFromY, strTableName)
    End If

   
End If

intFromRow = intFromRow + 1
If intFromRow > 500 Then
     Exit Do
End If

Loop

End Sub

Sub getFromXY(ByVal strTableName As String, ByVal strColumnName, ByRef intFromX As Integer, ByRef intFromY As Integer)
    intFromX = 0
    intFromY = 0
   
Dim intTableRow As Integer
Dim intColumn As Integer
Dim strColumn As String
Dim strTName As String
Dim intScanColumn As Integer
   
    intColumn = 3
    intTableRow = 1
   
Do While True

strTName = Sheets("FromTable").Cells(intTableRow, intColumn).Value
If strTableName = strTName Then
    Exit Do
End If
intTableRow = intTableRow + 1
If intTableRow > 500 Then
     Exit Do
End If

Loop

intScanColumn = 4
Do While True

strColumn = Sheets("FromTable").Cells(intTableRow + TableSpace, intScanColumn).Value
If strColumn = strColumnName Then
    intFromX = intTableRow + TableSpace
    intFromY = intScanColumn
    Exit Do
End If

intScanColumn = intScanColumn + 1
If intScanColumn > 255 Then
     Exit Do
End If

Loop

End Sub

Sub setToXY(ByVal strTableName As String, ByVal strColumnName, ByVal intFromX As Integer, ByVal intFromY As Integer, ByVal strFromTableName As String)

Dim intTableRow As Integer
Dim intColumn As Integer
Dim strColumn As String
Dim strTName As String
Dim intScanColumn As Integer
   
    intColumn = 3
    intTableRow = 1
   
Do While True

strTName = Sheets("ToTable").Cells(intTableRow, intColumn).Value
If strTableName = strTName Then
    Exit Do
End If
intTableRow = intTableRow + 1
If intTableRow > 500 Then
    Exit Do
End If

Loop

intScanColumn = 4
Do While True

strColumn = Sheets("ToTable").Cells(intTableRow + TableSpace, intScanColumn).Value
If strColumn = strColumnName Then
    Sheets("ToTable").Cells(intTableRow + TableSpace + 9, intScanColumn).Value = strFromTableName
    Sheets("ToTable").Cells(intTableRow + TableSpace + 10, intScanColumn).Value = Sheets("FromTable").Cells(intFromX, intFromY).Value
    Sheets("ToTable").Cells(intTableRow + TableSpace + 11, intScanColumn).Value = Sheets("FromTable").Cells(intFromX + 1, intFromY).Value
    Sheets("ToTable").Cells(intTableRow + TableSpace + 12, intScanColumn).Value = Sheets("FromTable").Cells(intFromX + 2, intFromY).Value

    Exit Do
End If
intScanColumn = intScanColumn + 1
If intScanColumn > 255 Then
    Exit Do
End If

Loop

End Sub