请大师帮忙,具体在我的模块上的要求,谢谢!

lsc900707

凯哥003 发表于 2017-4-28 18:12
谢谢大哥哥.用表控按钮可以,我再做个清空按钮.随时待用.如果[出厂水泥]的B5能同时调回,因32.5R和42.5R的B ...

那肯定可以。晚一点回复。现在在开紧急会议。

凯哥003

lsc900707 发表于 2017-4-28 19:41
那肯定可以。晚一点回复。现在在开紧急会议。

好的,我从新做下文件(在13楼)只不过是平均值公式用表控

凯哥003

lsc900707 发表于 2017-4-28 19:41
那肯定可以。晚一点回复。现在在开紧急会议。

文件我重做一个在19楼,谢谢大哥哥鼎力之作

lsc900707

凯哥003 发表于 2017-4-28 20:20
文件我重做一个在19楼,谢谢大哥哥鼎力之作

我看到你已经做好了，不错>>>>>>>>>

凯哥003

lsc900707 发表于 2017-4-28 21:50
我看到你已经做好了，不错>>>>>>>>>

谢谢大哥哥!出厂水泥B6我是用有效性选择.还不能在32.5R和42.5R模板上召回

lsc900707

凯哥003 发表于 2017-4-28 22:58
谢谢大哥哥!出厂水泥B6我是用有效性选择.还不能在32.5R和42.5R模板上召回

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address <> [e5].Address Then Exit Sub
    If Len([e5]) Then
        If [e5] = "32.5R" Then
             [b5] = "复合硅酸盐水泥"
             arr = Sheet1.[a1].CurrentRegion
             ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2))
             For i = 8 To UBound(arr) - 1
                 k = k + 1
                 For j = 1 To UBound(arr, 2)
                     brr(k, j) = arr(i, j)
                 Next
             Next
         End If
         If [e5] = "42.5R" Then
             [b5] = "普通硅酸盐水泥"
             arr = Sheet3.[a1].CurrentRegion
             ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2))
             For i = 8 To UBound(arr) - 1
                 k = k + 1
                 For j = 1 To UBound(arr, 2)
                     brr(k, j) = arr(i, j)
                 Next
             Next
         End If
    End If
    [a8:d27].ClearContents
    If k Then [a8:f9].Resize(k) = brr
End Sub

凯哥003

lsc900707 发表于 2017-4-28 23:11
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address  [e5].Address Then Exit ...

这是lsc900707大哥哥的杰作,好好向你学习,不知如何报恩,此生永远感激您对我的帮助,如方便留个TEL

凯哥003

lsc900707 发表于 2017-4-28 23:11
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address  [e5].Address Then Exit ...

大哥哥:以下次数怎样改包含以前使用次数,如何实现按现在开始改重新计次
On Error Resume Next
Application.ScreenUpdating = False
Dim wd As Window
Set wd = ActiveWindow
Dim i As Integer
With Worksheets("模块")
      
    .Activate
    .ScrollArea = "A1:K34"
End With
i = Worksheets("模块").Range("A50005").Value
i = i + 1
Worksheets("模块").Range("a50005").Value = i
If i < 30 Then
MsgBox "你还有" & (31 - i) & "次使用权限"
Else
    ThisWorkbook.Close True
    wd.Close True
End If
谢谢大哥哥!如有方便请改下

lsc900707

凯哥003 发表于 2017-5-3 14:25
大哥哥:以下次数怎样改包含以前使用次数,如何实现按现在开始改重新计次
On Error Resume Next
Applicat ...

有时间帮你看看，不过我没弄过这个。

lsc900707

凯哥003 发表于 2017-5-3 14:25
大哥哥:以下次数怎样改包含以前使用次数,如何实现按现在开始改重新计次
On Error Resume Next
Applicat ...

Worksheets("模块").Range("A50005").Value把这个单元格的值改为0就重新开始计数了。