完美Excel

最近，接到一名网友的问题，大致要实现如下要求：

• 在A列中有一系列值，在B列中是0-365及以上的数值，但B列中的数值不是按0，1，2…等顺序排列的，而是较凌散，且A列和B列中的数据都存在空行。要求将B列中0-30的数值所对应的A列中的数值汇总、B列中31-60的数值所对应的A列中的数值汇总，即将B列中按顺序的每30个数字所对应的A列中的数据汇总。

如下图所示：

其中，E列中的值是运行程序后自动汇总的值。
再详细解释一下，例如，在B列中属于0-30之间的值所在的单元格是B2，其对应的A列中的值是1，因此在这个范围中的数值相加的结果为1；在B列中属性31-60之间的值所在的单元格是B4和B6，所对应的A列中的值分别为5和7，其和为12，……，等等。
下面是程序代码：
Sub test()
    Dim numVal(), iMax, iArray, i, j, k, m, lLastRow, rng, rngCal
    iMax = WorksheetFunction.Large(Range(”B:B”), 1)
    iArray = Int(iMax / 30)
    ReDim numVal(0 To iArray)
    lLastRow = Range(”B65536″).End(xlUp).Row
    Set rng = Range(”B1:” & “B” & lLastRow)
    Set rngCal = Range(”A1:” & “A” & lLastRow)
    Range(”E2:E65536″).Clear
    For i = 2 To lLastRow
         j = Int(rng(i) / 30)
         k = rng(i) - Int(rng(i) / 30) * 30
         If k <> 0 Then
             numVal(j) = numVal(j) + rngCal(i)
         End If
         m = j - 1
         If k = 0 And (m = 0 Or m > 0) Then
             numVal(m) = numVal(m) + rngCal(i)
         End If
    Next i
    For i = 2 To iArray + 2
        Range(”E” & i) = numVal(i - 2)
    Next
End Sub

为了简单起见，没有声明具体的数据类型。并且，在代码中的变量初始值可以根据具体的工作表中的值来作出改变，以适应具体的工作环境。

“南山物流进销存”说明文档
近期利用空闲时间试着解决gtbb2002朋友在EH上提出的一个实用问题，主要是利用Excel解决物流进销存的方案，他给出了Excel界面和部分数据，并提出了要解决的问题。
看看下面的界面，是用Excel做的，很漂亮！

其问题如下：
1、窗口录入只有5行，可录入可能有10-30种，能不能增加一个下拉窗口。
2、在录入产品时，如果输入条形码或是批量复制品名规格各产品时，能自动导入后面几列的相关信息，如品名规格，产地、单价。注：添加到入库单是产品信息的进价，添加到出库单是批发价。如果可以的话，当添加到出库单时，数量不是整数时，即小数那么单价则是零售价。
3、按下保存时，如果单元格是选择入库单则保存在入库单，如果单元格是选择出库单则保存在出库单。
4、查找要求：
a、创建一个查找窗口。可以查找某一个时间段的入库、出库产品清单。
b、或是具体查找某一天的入库、出库产品清单。
c、根据生产单号查找入库或出库的产品清单。
最后一个比较难的要求：
能不能增加一个计算利润按钮：计算：每种产品进货渠道不同，进价不同，客户不同，卖出的价格也不同……
已解决并提供的功能
其实这个问题除了要求在有限的Excel工作表输入空间提供下拉窗口之外，其它的都不难。初步完成的作品已有下列功能：
1、当录入窗口中，超过6行时，会自动提供一个空白行，并显示滚动条，这样，不仅可以继续录入，而且还能够利用滚动条查看已录入的数据，甚至修改已录入的数据。
2、如果是入库单，当输入品名规格时会自动在相应的单元格中输入条形码、产地、单价；如果是出库单，当输入品名规格时会自动在相应的单元格中输入条形码、产地，输入数量后，会自动输入单价，改变数量时(主要是由整数变小数，或由小数变整数)，会自动调整单价。
(注：由于条形码不是唯一的，因为没有做输入条形码后自动输入其它相关列信息的功能)
3、按下保存时，将根据单据名目保存。
4、按下新建时，可选择是否保存已在录入窗体中保存的数据。无论是否保存，都将清除输入区域，供输入新的数据。
5、按下查找时，将出现一个查找结果的工作表，上面有三个按钮，这些按钮的左侧均有用蓝色边框围着的输入单元格。输入相应的条件，按下按钮后将显示查找的结果。
6、最后一个要求，由于表述与提供的数据有矛盾，故没有做这个功能。其实，需求者您可以将数据好好设计一下，实现这个功能应该相当容易。
解决思路
将解决思路写下来，供以后参考。
1、针对窗口录入只有5行，可录入可能有10-30种，要求增加下拉窗口
在录入窗口工作表中，增加一个滚动条控件，在工作簿中增加一个临时数据工作表。仿ListView控件的功能，即当在最后一行中输入完成后，在其下自动增加一个空行，已输入完成的数据上移。在本例中，实际上没有增加行，只是将输入完的数据上移，使最后一行为空，而临时数据工作表就是起到存储输入区域的数据以及与输入区域交换数据的功能。这样，就出现了一个列表框的效果，实际上“临时数据”工作表是后台。
2、同步工作表
“录入窗口”工作表和“临时数据”工作表同步，即在录入窗口工作表中一行录入数据完成则存放在临时数据工作表中，以备后面获取数据。
3、一切利用临时数据工作表作为中介，当数据超过6行时，再启用滚动条，滚动条主要用于提供一个数字，与录入窗口工作表和临时数据工作表中的行数相关联，从而在录入窗口中反映前面录入的数据。并且可以随时更新各工作表，而使数据正确，不会出现重复数据而没有反映改变后的情况。
此时，应注意滚动条与工作表行相对应的最前面和最后面的数值。
4、利用这个工作簿时，在录入窗口工作表中到达第18行之前，C、D两列必须填完整；在第18行中，该行必须填完整才能出现空行。
小结：首先实现录入窗口工作表与临时数据工作表同步，即录入一行，在临时数据工作表中增加一行，若超过6行，则自动在录入窗口工作表中“增加”一行。
然后，利用滚动条实现对超过6条录入的数据，可以在录入窗口中看到之前录入的所有数据。
第三，考虑到可能有输入错误，因此当修改已录入的数据时，能同步更新临时数据工作表，从而使数据保持最新。
注：临时数据工作表是真正保存所录入数据的工作表，所以也是操作的中心。一切数据都保存于其中，一切数据也取之于其中，并能更新修改过的数据。
第四，当本次输入的数据完成后，能够及时清除临时数据工作表及录入窗口工作表中的数据。
5、在关闭工作簿前，清空数据
6、几项注意的地方：
（1）变量应该及时清零。
（2）注意循环变量的初始值有无变化。
（3）滚动条Change事件的触发情形。当为滚动条赋最小值和最大值时，不会触发其Change事件，而当为其赋Value属性值时，则会触发。
（4）注意，每次事件触发后的变量值
7、当事件很多，相互有干扰时，可使用语句Application.EnableEvents = False来禁用特定的事件。在大量利用对象事件编程的程序中，有时会出现程序没有反应的情况，这可能是禁用事件所造成，可运行语句Application.EnableEvents = True试试。
8、要取类中的属性值，则要引用类。特殊的，引用工作表对象模块中的属性值，则要加上工作表对象名。
9、查找方法找到的是一个对象，因而应该用Set关键字。通常，对象变量要使用Set关键字赋值。
时间所限，还存在的问题，一般不会妨碍操作，但需规范操作，否则可能有错误的数据存在。
只能输入品名规格并自动导入相关信息，而不能输入条形码后自动导入相关信息，主要是考虑到品名规格是唯一的而条形码不是，再加上工作表中限定的输入行仅6行，如果重复的条形码较多的话，实现起来有一定的难度，故而在这里从简。
还有很多可以改进的地方和需要改进的地方，这要看具体的使用情况了。
此外，输入窗口的界面可以进一步改进，例如仅限定在特定区域输入。
详细问题和解答参见:http://club.excelhome.net/dispbbs.asp?boardid=2&replyid=1248116&id=305023&page=1&skin=0&Star=2
示例文档参见:http://www.drexcel.cn/article.asp?id=39

前两天接到panpanluo的问题：

• 要求将一个名为“93定额库.xls”的工作簿中的数据，根据选取的定额类别导入到自定义用户窗体中，然后在窗体中可实现查询，能找到并选择相应的定额条目，然后输入到另一个工作簿的计算工作表中。在他提供的用户窗体中，主要的两的控件是TreeView控件和ListView控件。

花了一些时间对其需求进行了研究，根据自已的理解，初步解决了这个问题(当然，细节问题肯定还存在，再作些修改即可)。
下面，将自已解决问题过程中的一些想法和思路记录在此，以供以后参考。
一、工作表中数据结构的设计很重要，特别是对于有大量数据的工作簿，有规律的数据结构不仅有助于代码的编写和扩展，而且也便于理解。
在本例中，因为是涉及到工程定额数据，数据量肯定很大，幸好这些数据的编排和层次结构很合理，因而编写程序对其处理很方便。
建议：在编写程序对数据进行处理之前，尽量使数据规范，有规律，或者对数据进行整理，使其尽可能规范，特别是对于大量的数据，更应如此。这里说的结构规范，不仅仅是对于要处理的工作表，而且还包括接受输入数据的工作表。
二、实现目的有多种方法，尽量使用自已熟悉的方法和工具。
本例中，我在用户窗体中使用了列表框控件，而没有使用ListView控件。如图：

界面中，包含一个用于选取定额类型的组合框、一个用于搜索的文本框、一个TreeView控件、一个列表框和五个按钮。
三、程序思路
1、整理工作表中的数据，正如上面所述，规范的数据便于程序实现，也会使代码更少。本例中，将工作簿“93定额库.xls”中的各工作表中的定额数据进行整理，主要是提取父节点和相应的子节点，以方便用于TreeView控件中。
下面的程序是一个通用程序，能方便地将整理后的数据填充到TreeView控件中。稍作修改，就能用于其他情形。
Sub treeViewPopulate()
    Dim i           As Long
    Dim j           As Long
    Dim xNode       As Node
    Dim NodeKey     As String
    Dim objWks      As Worksheet
   
    Set objWks = Workbooks(”93定额库.xls”).Sheets(strWksName)
    j = objWks.Range(”A65536″).End(xlUp).Row
    With Me.TreeList
        ‘第一层次的节点
        For i = 2 To j
            Set xNode = .Nodes.Add
            NodeKey = objWks.Range(”A” & i).Text
            With xNode
                .Key = NodeKey
                .Text = NodeKey
                .Expanded = False
            End With
        Next i
        j = objWks.Range(”C65536″).End(xlUp).Row
        ‘其他节点
        For i = 2 To j
           Set xNode = .Nodes.Add(objWks.Range(”B” & i).Text, tvwChild)
            NodeKey = objWks.Range(”C” & i).Text
            With xNode
                .Key = NodeKey
                .Text = NodeKey
            End With
        Next i
    End With
   
    Set xNode = Nothing
    Set objWks = Nothing
End Sub
2、填充列表框，因为数据是一个区域，所以很方便地将数据填充到列表框中。如本例中的过程Sub listBoxPopulate()。
3、实现TreeView控件和列表框中的控件相交关联。
Private Sub TreeList_NodeClick(ByVal Node As MSComctlLib.Node)过程用于在单击TreeView控件中的相应节点后，在列表框中显示对应的节点内容。由于选中某节点后，其对应的节点内容在列表框中总会出现在列表框的最下部，因此，本过程使用了一个小小的技巧，即在列表框中先选取要选择的节点的下一个节点，再选取要选择的节点，因为列表框默认一次只能选择一项，因此将要选择的节点内容上移，使项目能看清楚。
注：在使用循环时，一定要注意最开始和最末尾的循环变量，防止超出变量的范围。
Private Sub listBoxHandle_Click()过程用于单击列表框中相应的项目后，TreeView控件中相应的节点显示。
实际上，这两个控件是独立的，在这里只是通过工作表中的相应数据进行关联，即工作表是中间人。
4、实现搜索。当然，搜索到一项很容易，但要进行连续搜索则稍复杂一些。连续搜索的目的是能找到包括搜索文本的所有项。使用了一个通用的搜索程序：
Function FindAll(SearchRange As Range, FindWhat As Variant, _
    Optional LookIn As XlFindLookIn = xlValues, Optional LookAt As XlLookAt = xlWhole, _
    Optional SearchOrder As XlSearchOrder = xlByRows, _
    Optional MatchCase As Boolean = False) As Range
”””””””””””””””””””””””””””””””””””””””””””””
‘ 返回SearchRange区域中含有FindWhat所代表的值的所有单元格组成的Range对象
‘ 其参数与Find方法的参数相同
‘ 如果没有找到单元格,将返回Nothing.
”””””””””””””””””””””””””””””””””””””””””””””
  Dim FoundCell As Range
  Dim FoundCells As Range
  Dim LastCell As Range
  Dim FirstAddr As String
  With SearchRange
    Set LastCell = .Cells(.Cells.Count)
  End With
  Set FoundCell = SearchRange.Find(what:=FindWhat, after:=LastCell, _
    LookIn:=LookIn, LookAt:=LookAt, SearchOrder:=SearchOrder, MatchCase:=MatchCase)
  If Not FoundCell Is Nothing Then
    Set FoundCells = FoundCell
    FirstAddr = FoundCell.Address
    Do
      Set FoundCells = Application.Union(FoundCells, FoundCell)
      Set FoundCell = SearchRange.FindNext(after:=FoundCell)
    Loop Until (FoundCell Is Nothing) Or (FoundCell.Address = FirstAddr)
  End If
  If FoundCells Is Nothing Then
    Set FindAll = Nothing
  Else
    Set FindAll = FoundCells
  End If
End Function
该程序能够在指定的区域中找到满足条件的所有单元格，因而为连续搜索提供了基础。
此时，注意搜索到相应的项目后，在列表框中选中搜索到的项目，同时TreeView控件中的节点相应扩展显示。
5、其他。选中组合框中的项目后，在TreeView控件和列表框控件中出现对应的项目。单击“展开”按钮，将展开TreeView控件中所有节点，单击“收起”按钮则折叠所有节点。“输入到计算表”将组合框和列表框中的相应数据输入到“计算表”对应的单元格中。
四、一些注意事项
1、注意，考虑在各控件中没有相应输入时的情形，如果没有输入而执行搜索或单击按钮操作，则会出现错误。
2、注意，本例是两个工作簿相互操作，最终一个工作簿获取另一个工作簿中的数据，因此两个工作簿要同时打开，并且两个工作簿都要处于同一进程中(即在同一Excel界面中打开，而不能再开启一次Excel应用程序后打开另一工作簿)。
3、何时激活相应的工作簿，应注意，否则会出现奇怪的现象─—列表框中没有数据，是空白的，但可以选择。
4、在使用附加控件时，最好也选中“引用”对话框中“Microsoft Windows Common Controls(SP6)”前的复选框。如果在“引用”对话框中找不到该选项，则应安装。
5、此外，对于循环结构，在完成(达到)目的后，即退出循环。对于对象变量，在使用完后，记得释放变量。
原问题及附件见(我的回答也在这个贴子里)http://club.excelhome.net/dispbbs.asp?boardid=2&replyid=1232490&id=302386&page=2&skin=0&Star=2
也可以在下面的链接中下载解答:http://www.drexcel.cn/article.asp?id=38
需求者根据别人的提示，并融合了各种功能，加上自已的设计，最终得出了很好的实用效果，然后拿出来与大家分享！请见：http://club.excelhome.net/dispbbs.asp?boardID=2&ID=306173&page=1&px=0

这是一个朋友所提出的问题，为了容易表述，使用了下面的工作表图片：

其意思好像是说，在工作表的A1单元格和B1单元格中有两个数字，这两个数字有一部分相同，现在要找出其中相同的数字并写入单元格C1，找出A1中有而B1中没有的数字并写入单元格D1，找出B1中有而A1中没有的数字并写入单元格E1。
我不知道给出的数字是否都是按这样的规律，即第一个原始数据的后面几位数与第二个原始数据的前面几位数相同。如果是这个规律的话，则可以就这个具体的例子给出下面的代码来实现：
Sub SeparateNumber()
    Dim strFirst As String
    Dim strResult As String
    Dim StartNum As Integer
    Dim EndNum As String
    Dim i As Integer, j As Integer
    strFirst = Left(Range(”B1″), 1)
    StartNum = InStr(1, Range(”A1″), strFirst)
    j = 1
    For i = StartNum To Len(Range(”A1″))
        EndNum = Mid(Range(”A1″), i, 1)
        If EndNum = Left(Range(”B1″), j) Then
            j = j + 1
        End If
    Next i
    If j > 1 Then
        strResult = Mid(Range(”A1″), StartNum, i - 1)
    End If
    ‘单元格C1中的数据
    Range(”C1″).Value = strResult
    ‘单元格D1中的数据
    Range(”D1″).Value = Left(Range(”A1″), StartNum - 1)
    ‘单元格E1中的数据
    Range(”E1″).Value = Right(Range(”B1″), Len(Range(”B1″)) - j)
End Sub
代码很简单，只是运用了几个VBA函数。
讨论：

• 其实代码可以进一步简化，因为VBA还有一个数组函数(Split函数)。
• 如果要将其变为通用的，则可将上述代码转化为自定义函数，并用相对量代替代码中的硬编码。
• 两个单元格中的数字如果不是按上面提到的规律，则可能两个单元格中的数字中间部分相同，而其它部分不同；或者一个单元格中的数字结尾部分和另一个单元格中的数字的中间部分相同；等等。

有兴趣的朋友可以继续研究。

问题：如何按照条件查找所给单元格中的内容，并将找到的内容放在相邻单元格中？
例如，单元格A1中的内容为“This is a test”，单词“just”在一对尖括号中。现在想将“just”提取出来，并将其放置在相邻的单元格B1中，如何使用VBA代码来实现这样的操作？
分析：可以使用InStr函数来查找左尖括号“<”和右尖括号“>”的位置，然后使用Mid函数来提取尖括号之间的内容。当然，可以更简单一些，使用Like运算符和Split函数。
代码一：
Sub CopyAndDepositTextWithinBrackets1()
    On Error Resume Next
    Dim rngCell As Range
    Dim strName As String
    Dim OpenBracket As Integer
    Dim CloseBracket As Integer
    For Each rngCell In Range(”A1″, Range(”A1″).End(xlDown))
        strName = rngCell.Value
        OpenBracket = InStr(1, strName, “<”)
        CloseBracket = InStr(1, strName, “>”)
        rngCell.Offset(0, 1).Value = Mid(strName, _
            OpenBracket + 1, CloseBracket - OpenBracket - 1)
    Next rngCell
End Sub
代码二：
Sub CopyAndDepositTextWithinBrackets2()
    Dim rng As Range
    For Each rng In Range(”A1″, “A” & Range(”A1″).SpecialCells(xlLastCell).Row)
        If rng Like “*<*>*” Then rng.Offset(, 1).Value = _
           Split(Split(rng, Chr(60))(1), Chr(62))(0)
    Next rng
End Sub