Excel代码问题，非常感谢！

LSYYLW · 发表于 2024-12-15 09:54

2024-12-15-.zip (3.22 KB, 下载次数: 5)

chxw68 · 发表于 2024-12-15 09:57

Sub test()
Dim r%, i%
Dim arr, brr() As Integer
With Worksheets("sheet1")
r = .Cells(.Rows.Count, 6).End(xlUp).Row
arr = .Range("f51:f" & r)
ReDim brr(1 To UBound(arr), 1 To 1)
For i = 2 To UBound(arr)
If arr(i, 1) = arr(i - 1, 1) Then
brr(i, 1) = arr(i, 1)
End If
Next
.Range("k51").Resize(UBound(brr), 1) = brr
End With
End Sub

复制代码

chxw68 · 发表于 2024-12-15 09:58

这么简单的问题，楼主自己应该会吧。

quqiyuan · 发表于 2024-12-15 13:32

以前的稍作改动即可，仅供参考。。。。

quqiyuan · 发表于 2024-12-15 13:33

代码如下。。。。
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Target.Address = "$K$1" Then
      crr = [f51:f150]
      ReDim arr(1 To UBound(crr), 0)
      arr(1, 0) = 0
      For i = 2 To UBound(crr)
         arr(i, 0) = 0
         If crr(i, 1) = crr(i - 1, 1) Then
            arr(i, 0) = crr(i, 1)
         End If
      Next
      Beep
      [k51].Resize(UBound(arr)) = arr
End If
Application.EnableEvents = True
End Sub

LSYYLW · 发表于 2024-12-15 13:52

chxw68 发表于 2024-12-15 09:58
这么简单的问题，楼主自己应该会吧。

非常感谢老师，鲜花稍后为您献上。

LSYYLW · 发表于 2024-12-15 13:53

quqiyuan 发表于 2024-12-15 13:32
以前的稍作改动即可，仅供参考。。。。

非常感谢老师，代码非常好用，鲜花稍后为您献上。

LSYYLW · 发表于 2024-12-19 10:42

本帖最后由 LSYYLW 于 2024-12-19 10:51 编辑

2024-12-19---.zip (4.53 KB, 下载次数: 2)

LSYYLW · 发表于 2024-12-19 10:44

quqiyuan 发表于 2024-12-15 13:33
代码如下。。。。
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents ...

老师您好：又来麻烦您了，您有时间的时候帮我看一下8楼附件里的问题，拜托您了！

quqiyuan · 发表于 2024-12-19 13:21

参与一下，仅供参考。。。。

		自动登录	找回密码
密码			免费注册

[求助] Excel代码问题，非常感谢！

评分

评分

评分

评分

评分