简单写个工具

最新推荐文章于 2024-07-28 19:09:18 发布

原创最新推荐文章于 2024-07-28 19:09:18 发布 · 508 阅读

0 ·

CC 4.0 BY-SA版权

文章标签：

#工具 #integer #string #table #工作 #function

vba 专栏收录该内容

3 篇文章

订阅专栏

本文介绍了一个使用VBA编写的简单工具，该工具能够从模板表中读取配置信息，并根据这些信息从“Data”表中查找数据，再将特定的数据写回到另一个表中。此工具适用于需要频繁进行数据更新和维护的场景。

明天周一了，又要开始一周的工作了，为了下周顺利工作，临阵写了个简单工具的雏形，又不能给公司发mail,也用不了usb, 只好把代码贴到这了。

Const TableSpace As Integer = 4

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 = 2
    intTableRow = 1

Do While True

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

Loop

intScanColumn = 2
Do While True

strColumn = Sheets("Data").Cells(intTableRow + TableSpace, intScanColumn).Value
If strColumn = strColumnName Then
    getData = Sheets("Data").Cells(intTableRow + TableSpace + 1, intScanColumn).Value
    Exit Do
End If
intScanColumn = intScanColumn + 1
If intScanColumn > 1000 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 = 2
    intTableRow = 1

Do While True

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

Loop

intScanColumn = 2
Do While True

strColumn = Sheets("Sheet3").Cells(intTableRow + TableSpace, intScanColumn).Value
If strColumn = strColumnName Then
     Sheets("Sheet3").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