【图片】回复：Excel可以做什么，Excel工作笔记[全员乱入]【excel吧】

这样会快点
Dim flag As Boolean
Sub test()
Dim i As Integer
Cells(1, 1).Select
For i = 1 To 99
Call FindRest(i, 500, "")
Next i
End Sub
Sub FindRest(ByVal iStart As Integer, ByVal iTotal As Integer, ByVal sNum As String)
Dim i As Integer
If iStart > iTotal Then Exit Sub
sNum = sNum & "+" & iStart
If iStart = iTotal Then
Selection = sNum
Selection.Offset(1, 0).Select
flag = True
Exit Sub
End If
For i = iStart To iTotal
Call FindRest(i + 1, iTotal - iStart, sNum)
If flag Then
flag = False
Exit Sub
End If
Next i
End Sub

自定义函数，如果想要知道这个函数写在那里了，可以用caller来得到。估计对107楼的有帮助。@tcwang11 @青水蛙鸣

试试看 @ws786873 在所有打开的表格中，如果名称满足条件，就复制粘贴然后自动跳到下一行
Sub ws786873()
a = "汇总费登记4月.xls"
b = "*费登记4月.xls"
Workbooks(a).Activate
Sheets(1).Select
Rows(2).Select
For Each wb In Workbooks
If wb.Name Like b Then
If wb.Name <> a Then
wb.Sheets(1).Rows(2).Copy
Selection.PasteSpecial Paste:=xlPasteValues
Selection.Offset(1).Select
wb.Sheets(2).Copy Before:=Workbooks(a).Sheets(2)
End If
End If
Next
End Sub

数组公式的话有数组公式的属性 FormulaArray

最近工作太忙没有持续更新新的内容, 自己瞎顶一下, 纪念签到百天.
提到百天, 怀念小兔 @温柔小兔

@青水蛙鸣 @Will__Cheung @xzk235
自定义函数完成版
单元格输出结果如下
2 found:
1-A:1,4-B:3,3-C:2,2-D:1,Total=7;
2-A:1,4-B:3,3-C:2,1-D:1,Total=7;
Public aResult As Variant
Function UO(rMatrix As Variant) As Variant
Dim iSize As Integer
Dim aMatrix As Variant
Dim iResult As Integer, iColumn As Integer, iLineTotal As Integer, iMax As Integer, iSenorioCount As Integer
Dim sResult As String, sLineResult As String
ReDim aResult(0)
aMatrix = rMatrix
iSize = UBound(aMatrix, 2)
Call Pick("", iSize)
For iResult = 1 To UBound(aResult)
iLineTotal = 0
sLineResult = ""
For iColumn = 1 To iSize
iLineTotal = iLineTotal + aMatrix(Mid(aResult(iResult), iColumn, 1), iColumn)
sLineResult = sLineResult & rMatrix.Cells(1, 1).Offset(Mid(aResult(iResult), iColumn, 1) - 1, -1) & "-" & rMatrix.Cells(1, 1).Offset(-1, iColumn - 1) & ":" & aMatrix(Mid(aResult(iResult), iColumn, 1), iColumn) & ","
Next iColumn
sLineResult = sLineResult & "Total=" & iLineTotal & ";" & vbCrLf
If iLineTotal > iMax Then
iSenorioCount = 1
iMax = iLineTotal
sResult = sLineResult
ElseIf iLineTotal = iMax Then
iSenorioCount = iSenorioCount + 1
sResult = sResult & sLineResult
End If
Next iResult
sResult = iSenorioCount & " found: " & vbCrLf & sResult
UO = sResult
End Function
Sub Pick(ByVal s As String, iSize As Integer)
Dim i As Integer
For i = 1 To iSize
If InStr(1, s, i) Then
ElseIf Len(s) + 1 = iSize Then
ReDim Preserve aResult(UBound(aResult) + 1)
aResult(UBound(aResult)) = s & i
Else
Call Pick(s & i, iSize)
End If
Next i
End Sub

问题见http://tieba.baidu.com/p/2623292186
代码如下
查询第一张表下３个关键字的行，然后复制，无限制
Sub test()
Dim aKeys(1 To 3) As String
Dim i As Integer, iSheetNo As Integer
Dim rResult As Range, rSearchArea As Range, cFirstCell As Range, cFoundCell As Range
iSheetNo = 1
aKeys(1) = "90D"
aKeys(2) = " "
aKeys(3) = "SFE"
For i = LBound(aKeys) To UBound(aKeys)
If i = LBound(aKeys) Then Set rSearchArea = Sheets(iSheetNo).Cells
If cFirstCell Is Nothing Then Set cFirstCell = rSearchArea.Find(aKeys(i), , xlValues)
If cFirstCell Is Nothing Then GoTo lNoResult
Set cFoundCell = cFirstCell
Set rResult = cFirstCell.EntireRow
Do
Set cFoundCell = rSearchArea.Find(aKeys(i), cFoundCell, xlValues)
If cFoundCell.Address = cFirstCell.Address Then GoTo lNextKey
Set rResult = Union(rResult, cFoundCell.EntireRow)
Loop Until cFoundCell Is Nothing
lNextKey:
Set cFirstCell = Nothing
Set cFoundCell = Nothing
Set rSearchArea = rResult
Next i
If rResult Is Nothing Then
lNoResult:
MsgBox "No result found"
Else
rResult.Copy
End If
End Sub

Excel是一个工具, 很多时候你需要有对于复杂事务处理的思路, 他才能够帮到你. 在这里分享一下昨天刚刚完成的一个工作.
工作任务: 配置已经上线系统的产品信息.
主要难度: 要配置9万多条产品信息, 确保每一类产品的信息准确, 每一类都使用统一的配置方案(10大类,6级目录+不同币种), 因为系统已上线, 在我拿到资料以后, 同时有一组人对系统进行更新, 我需要不定期的导入新的资料. 而且产品ID不变的情况下本身内容可能改变. 最终会以我的文件为准更新系统. 而且好像... 没人检查...
大家有思路么?

好久没有更新了，放一段新的代码
通过系统api时间来调出系统时间（milseconds模式）
Private Type SYSTEMTIME
Year As Integer
Month As Integer
DayOfWeek As Integer
Day As Integer
Hour As Integer
Minute As Integer
Second As Integer
Milliseconds As Integer
End Type
Private Declare Sub GetSystemTime Lib "kernel32" (lpSystemTime As SYSTEMTIME)
Public Function GetTime() As String
Dim tSystem As SYSTEMTIME
GetSystemTime tSystem
GetTime = DateDiff("s", DateSerial(1970, 1, 1), DateSerial(tSystem.Year, tSystem.Month, tSystem.Day) + TimeSerial(tSystem.Hour, tSystem.Minute, tSystem.Second)) * 1000 + Format(tSystem.Milliseconds, "000")
End Function

好久么有认真的更新这个帖子了，最近 @誓约丶胜利的每日一贴看的不错，推荐大家阅读。 @247454238 提到了一个问题
247454238: 那我就补充个,比如如果要求有两个，含有北京或者上海字眼的，可以用=SUMIF(A1:A5,"上海",B1:B5)+SUMIF(A1:A5,"北京",B1:B5)。也可以是=SUMPRODUCT(SUMIF(A1:A5,{"上海","北京"},B1:B5)) 后面的原理至今不明····
出现了这种情况的时候我们要怎么做？看看下边的例子我们就可以开始讲这次的重点，公式编辑器和公式的调试方法。

如上图，公式已经给出，怎么知道为什么得到的结果是40呢？其实很容易，进入公式编辑栏，选中想要知道结果的表达式。

按F9，就知道了这个表达式返回的结果了。很多复杂的公式都可以这样一步一步的简化，由此方法，以后再也不怕那些头疼的数组公式了。

由此可以看出，
SUMIF(A1:A10,{2,3},B1:B10) = { SUMIF(A1:A10,2,B1:B10), SUMIF(A1:A10,3,B1:B10) }
是不是就容易理解多了呢？

下边讲讲公式编辑器，很多初学者都知道这个。
选中一个空单元格，点击公式编辑器 Fx 按钮，就可以打开公式目录，里边所有的可用公式，

Mac 版本的，请大家见谅。

选中合适的公式就可以了。
这里我想要介绍的是在有多个公式嵌套的情况下如何逐个查看，其实也非常简单。只要光标选中想要看的公式或公式内部，点 fx 键就可以了，公式编辑器会打开相应的公式，非常方便。

光标在 SUMIF 上，这时点击Fx，则会变成这样

除了SUMIF的部分，其他的部分都被隐去了，不要担心，编辑器关闭后就会出来的。
公式编辑器另外的一个主要部分是参数提示，即这个东西

点击公式名称的超级链接 SUMPRODUCT 部分，会打开关于此公式的帮助文件。
点击不同的参数，则会帮助定位每一个参数的表达式。（这里点的是 array1 )

再利用上边讲到的F9显示结果，便是最强大有效的公式调试工具。不知道你有用过么？

大家有兴趣的自己试试看，我会在下边做一个实例，公式简单，重在演示。

誓约丶胜利的帖子链接 http://tieba.baidu.com/p/2842920210
前两天回答的一个越过IF 7层嵌套的方法
帖子链接 http://tieba.baidu.com/p/2849976457
公式如下
=INDEX({"出勤不合格","三违","迟到","迟到两次","考核","创新","技工","年休假"},FIND("1",(--(K7<20))&(--AND(N7<>0,R7=1))&(--(R7=1))&(--(R7=2))&(--(N7<>0))&(--(O7<>0))&(--(P7<>0))&(--(L7>0))))
通过上边的方法一步一步的推倒
1. =INDEX({" 出勤不合格","三违","迟到","迟到两次","考核","创新","技工","年休假"},FIND("1", (--(FALSE))&(--AND(TRUE,TRUE))&(--(TRUE))&(--(FALSE))&(--(TRUE))&(--(TRUE))&(--(TRUE))&(--(TRUE))))
2. =INDEX({" 出勤不合格","三违","迟到","迟到两次","考核","创新","技工","年休假"},FIND("1", 0&1&1&0&1&1&1&1))
3. =INDEX({" 出勤不合格","三违","迟到","迟到两次","考核","创新","技工","年休假"},FIND("1", "01101111"))
4. =INDEX({" 出勤不合格","三违","迟到","迟到两次","考核","创新","技工","年休假"},2)
这就容易理解多了，通过find 1 在一连串判断表达式组成的01标识字符串中找到第一个符合条件的，然后通过index来获得相应的描述信息。
其实上边的这个函数有个缺点，在所有条件都不符合的话会返回错误，了解了原理以后就容易修改了，即，年休假后加 ,"无条件符合"，倒数第二个括号后前加 &1，就好了。@clinzli 希望能帮到你。

一段爬虫代码
Function GetProperty(iID As Long) As String
Dim doc As Object
Dim s$
Set doc = CreateObject("msxml2.XMLHTTP")
doc.Open "POST", "http://－－－－－－－－", False
doc.setrequestheader "Content-Type", "application/x-www-form-urlencoded; charset=UTF-8"
doc.setrequestheader "Accept", "text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8"
doc.setrequestheader "Accept-Encoding", "gzip, deflate"
doc.setrequestheader "Accept-Language", "en-US,en;q=0.5"
doc.setrequestheader "Content-Length", "23"
doc.setrequestheader "Host", "－－－－－－"
doc.setrequestheader "Referer", "－－－－－－－"
doc.setrequestheader "User-Agent", "Mozilla/5.0 (Macintosh; Intel Mac OS X 10.9; rv:26.0) Gecko/20100101 Firefox/26.0"
doc.send ("op=3&propertyId=" & iID)
GetProperty = doc.responseText
End Function

@duizijifuzeqq
选中要计算的单元格然后运行，多少不限
Sub RunSelection()
Dim dStDev As Double
Dim dAverage As Double
Dim rSelection As Range
Dim rRemove As Range
Dim rTemp As Range
Dim c As Range
Set rSelection = Selection
rSelection.ClearFormats
Do
dStDev = WorksheetFunction.StDev(rSelection)
dAverage = WorksheetFunction.Average(rSelection)
Set rRemove = Nothing
Set rTemp = Nothing
For Each c In rSelection
If Abs(c - dAverage) > dStDev * 3 Then
c.Interior.Color = RGB(256, 0, 0)
If rRemove Is Nothing Then
Set rRemove = c
Else
Set rRemove = Application.Union(rRemove, c)
End If
End If
Next
If Not rRemove Is Nothing Then
For Each c In rSelection
If Application.Intersect(c, rRemove) Is Nothing Then
If rTemp Is Nothing Then
Set rTemp = c
Else
Set rTemp = Application.Union(rTemp, c)
End If
End If
Next c
Set rSelection = rTemp
End If
Loop While Not rRemove Is Nothing
End Sub

好久没更了，放一个小功能，看大家用没用过
Ctrl + Space， Shift + Space 列选取，和行选取。第一个因为和微软输入法的默认键交叉，在不进行修改的情况下，中文系统相当于把这个给废了。

日	一	二	三	四	五	六

回复：Excel可以做什么，Excel工作笔记[全员乱入]

扫二维码下载贴吧客户端