工具vba

最新推荐文章于 2024-09-23 12:14:22 发布
最新推荐文章于 2024-09-23 12:14:22 发布
阅读量663 收藏
点赞数
CC 4.0 BY-SA版权
分类专栏： vba 文章标签： vba 工具 integer string table manager
版权声明：本文为博主原创文章，遵循 CC 4.0 BY-SA 版权协议，转载请附上原文出处链接和本声明。
本文链接：https://blog.youkuaiyun.com/MECHEAL/article/details/5983294

由于我组的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

 

 

 

 

 

VBA入门到进阶常用知识代码总结61
tiansdk320的博客
02-17 592
第61集 日期和进度条 295、 注意事项 注意：64位office无法加载该控件，32位可以运行。 296、 常用的日期控件 有2个，一个是DTPicker，另一个是Calendar。附加控件中选择Microsoft Dtae and Time Picker Control和日历控件 12.0。 DTPicker设置日期格式是，月份要大写。如：yyyy-MM-dd 297、 注册日历控件 Su...
VBA实现窗口登录
God_68的博客
10-29 6056
核心代码： ' 窗口事件 Private Sub CommandButton1_Click() ' 登录 If ComboBox2.Text = "" Or TextBox1.Text = "" Then MsgBox "请输入账户或密码", 1 + 64, "系统登录" Else If 特定用户密码登录(ComboBox2) = TextBox1.Text Then Unload Me MsgBox ComboBox2.Text & "你好!欢迎你进入本系统", 1 + 64, "欢迎词.
Excel 2010 VBA 入门 128 在窗体中插入控件
复行数十步
11-01 8116
目录 步骤 控件工具栏 控件的顺序 控件的组合 步骤 步骤1 在工作表中插入一个按钮，将其命名为CommandButton1，Caption属性为“显示窗体”。 步骤2 按组合键【Alt＋F11】打开VBE。 步骤3 选择菜单“插入”→“用户窗体”。 步骤4 在“工程资源管理器”中双击之前插入的窗体，在“控件”工具箱中将CommandButton控件拖入窗体中，并调整大小和位置，如所图所示。 步骤5 在“工程资源管理器”中右键单击之前插入的窗体，选择“查看代码”，如图所示，然后在...
Excel VBA UserForm用户窗体中添加按钮，并进行选择
qq_39629993的博客
08-07 1万+
1、插入一个用户窗体 需要在用户窗体中加入按钮的，则需要打开“工具箱” 插入控件按钮 2、代码编写 （1）、首先在sheet中添加一个按钮，来显示用户窗体，查看效果 Private Sub CommandButton1_Click() UserForm1.Show End Sub 鼠标单击CommandButton1出现如下窗口，这是未对窗口进行任何代码编写的效果。 （2）、在用户窗体中编写代码，打开编写界面 两个主要函数 Private Sub UserForm_Initialize(
VBA的表单控件初接触（2）：ActiveX控件的基础功能和基础代码
奔跑的犀牛先生
03-02 6974
第1类：button ,option ,checkbox ,togglebutton ,分组框 一组togglebutton中会始终有一个是按下去的状态 如果是一组commandbutton就全部都始终都是弹起的状态 1.1 togglebutton 切换按钮/ 互斥按钮 1.1.1基本用法 首先是，togglebutton应该有多个，并且这多个逻辑上是一组的 基本功能就...
［转］VBA常用命令解析之001——On Error（将错就错）
roofwei的专栏
03-04 4192
VBA常用命令解析之001——On Error（将错就错）　　谁都希望自己的程序能一顺百顺，但是错误却一直是我们心中的痛。总是时不时地跳出来影响我们的情绪。虽然跳出来的错误提示会中断我们程序的运行，但是它就象我们的痛感觉神经一样，是一种保护。可以避免得到不正确的结果，甚至灾难性的后果发生。我们可以通过进一步的程序设计和改进来避免错误中断我们的程序。　　在日常生活中，我们知道手术
excel宏工具VBA工具合并excel合并多个工作簿工作表
10-17
excel宏工具VBA工具，合并多个excel文件 合并多个excel工作表excel宏工具VBA工具合并excel合并多个工作簿工作表
CAD实用工具VBA
05-20
在本话题中，我们主要关注的是一个名为“CAD实用工具VBA”的程序，它是一个利用VBA（Visual Basic for Applications）编程语言开发的定制工具。VBA是微软Office套件中的内置编程语言，它允许用户自定义功能和自动化...
Access数据库实用教程-教案-第8章-Access的编程工具VBA.docx
12-18
【Access数据库实用教程-教案-第8章-Access的编程工具VBA】 Access数据库系统不仅提供了数据管理和查询的工具，还支持使用Visual Basic for Applications (VBA)进行编程，以增强系统的功能和满足用户定制需求。VBA...
wps开发工具vba
10-29
做为Wps的忠实使用者，一直坚持到现在，很长一段时间是Wps与Ms共存的，没办法，有些功能，如宏，是WPs不可替代的，尽管我的宏用的不精，不过近日发现了一个软件，4.7M，WPs VBA7.0，安装之后，我的Win7系统+WPS2012...
VBA工具箱：VBA工具箱
02-04
VBA工具箱是一种用于Microsoft Office应用程序（如Excel、Word、Access等）的自动化和扩展功能的集合，它基于Visual Basic for Applications（VBA）编程语言。这个工具箱可以帮助用户更高效地处理数据、创建复杂的宏...
Excel-VBA宏编程：检测工作表控件选取状态的实战源代码
最新发布
weixin_35705784的博客
09-23 1630
本文还有配套的精品资源，点击获取 简介：VBA是Excel中的自动化编程工具，能增强其功能并自动化任务。本实例源代码文件介绍如何利用VBA检查工作表中各种控件的选取状态，如复选框和选项按钮。用户可以通过VBA编辑器创建模块、编写代码，并为控件添加事件处理程序来实现。通过分析源代码文件，读者可以提升VBA编程技能，应用于办公自动化中，提高工作效率和数据管理。 1. ...
vba 定义类_使用WithEvents定义响应事件的对象
weixin_39962356的博客
11-21 1888
大家好，我们继续VBA类的学习，在这套教程中，大家会逐步认识到很多事物的本质东西，在上一讲中我们提到事件的定义时指出，事件是对象的响应。这里的对象是指接收方或者称之为事件监听者。事件的整个过程对象：事件的发起方，或者称之为事件源（Event Source），可以为按钮对象；事件的响应方，或者称之为事件监听者（Event Sink），可以为窗体或者其他的对象。在上一讲也着重地指出：事件的监听方可以为...
n整数中1出现的次数 / 数字 1 的个数
shihao的博客
10-05 613
输入一个整数 n ，求1～n这n个整数的十进制表示中1出现的次数。 例如，输入12，1～12这些整数中包含1 的数字有1、10、11和12，1一共出现了5次。 示例 1： 输入：n = 12 输出：5 示例 2： 输入：n = 13 输出：6 解题思路 f(n))函数的意思是1～n这n个整数的十进制表示中1出现的次数，将n拆分为两部分，最高一位的数字high和其他位的数字last，分别判断情况后将结果相加，看例子更加简单。 例子如n=1234，high=1, pow=1000, last=234 可以将数
VB.NET中的sender、e和handles
李达
02-08 1万+
由于收费系统中，碰到几次事件的调用，对其中参数不是很理解，就总结了一下vb.net中的事件。 在vb6.0中事件非常简单，就拿最常用的单击按钮事件来说，vb中的代码是： Private Sub Command1_Click() MsgBox ("你点击了button1") End Sub     调用command1的单击事件也很简单： Private Sub Command2
利用宏合并一个工作薄下的多张表格方法
ADCadc123456789的博客
11-23 3311
利用宏合并文档需要保证格式一致性 宏代码： Private Sub CommandButton1_Click() Application.ScreenUpdating = False Rows(“2:1048576”).Clear Dim xrow As Integer, sht As Worksheet, rng As Range For Each sht In Worksheets If sh...
VBA入门
笔记本
01-05 782
VBA入门之一 Private Sub CommandButton1_Click() //按钮事件 etxt = "Hello world!!!" MsgBox etxt, 64, "宣告" End SubPrivate Sub CommandButton2_Click() MsgBox "你点击的单元格是: " & ActiveCell.A
使用EXCEL VBA代码自动群发带附件的邮件同时抄送给不同的人
热门推荐
qq_44716938的博客
04-16 2万+
使用EXCEL VBA代码自动群发带附件的邮件同时抄送给不同的人 Private Sub CommandButton1_Click() '要能正确发送并需要对Microseft　Outlook进行有效配置 On Error Resume Next Dim rowCount, endRowNo Dim objOutlook As New Outlook.Application Dim objMail...
评论
添加红包

请填写红包祝福语或标题

个

红包个数最小为10个

元

红包金额最低5元

当前余额3.43元 前往充值 >
需支付：10.00元
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付元
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明：

1.余额是钱包充值的虚拟货币，按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载，可以购买VIP、付费专栏及课程。

余额充值