wqfzqgk

帖子: 75
主題: 19
精華: 0
積分: 135
點名: 0
作業系統: win7
軟體版本: 2007 010
閱讀權限: 20
註冊時間: 2010-5-18
最後登錄: 2013-10-26

1^# 跳轉到 » 正序看帖

打印

字體大小: tT

發表於 2010-7-10 16:41 | 只看該作者

单元格内不重复字符

[版主管理留言]

Hsieh(2010-7-10 17:49): 請檢查代碼正確性

Sub 单元格内不重复字符()
Set d = CreateObject("scripting.dictionary")
Set e = CreateObject("scripting.dictionary")
For i = 1 To Len(ActiveCell.Value)
d(Mid(ActiveCell.Value, i, 1)) = ""
Next
On Error Resume Next
For i = 1 To Len(ActiveCell.Value)
e.Add Mid(ActiveCell.Value, i, 1), ""
If Err.Number = 457 Then d.Remove (Mid(ActiveCell, i, 1))
Err.Clear
Next
MsgBox Join(d.keys, "")
End Sub
Sub 单元格内不重复字符()
For i = 1 To Len(ActiveCell.Value)
For a = 1 To Len(ActiveCell.Value)
If Mid(ActiveCell.Value, i, 1) = Mid(ActiveCell.Value, a, 1) Then m = m + 1
Next
If m = 1 Then mm = mm & Mid(ActiveCell.Value, i, 1)
m = 0
Next
MsgBox mm
End Sub
可以改为自定义函数！

樓主熱帖

学习

ui123

中學生 Rank: 2

帖子: 73
主題: 11
精華: 0
積分: 100
點名: 0
作業系統: Win 8
軟體版本: 2007
閱讀權限: 20
性別: 女
註冊時間: 2013-5-11
最後登錄: 2018-7-25

論壇榮譽勳章論壇贊助勳章

7^#

發表於 2014-7-21 11:31 | 只看該作者

回復 2# GBKEE
大大問你喔!!
為什麼找不到重複，用下面的方法加入字典裡，紅色地方看不懂，="" 不是代表沒有東西嗎? 為什麼變成加入字典?
d(Mid(ActiveCell.Value, i, 1)) = ""

TOP

wqfzqgk

中學生 Rank: 2

帖子: 75
主題: 19
精華: 0
積分: 135
點名: 0
作業系統: win7
軟體版本: 2007 010
閱讀權限: 20
註冊時間: 2010-5-18
最後登錄: 2013-10-26

6^#

發表於 2010-7-11 16:32 | 只看該作者

这个方法不错

学习

TOP

Hsieh

超級版主 Rank: 8 Rank: 8

帖子: 4901
主題: 44
精華: 24
積分: 4916
點名: 119
作業系統: Windows 7
軟體版本: Office 20xx
閱讀權限: 150
性別: 男
來自: 台北
註冊時間: 2010-4-30
最後登錄: 2025-5-17

2024年全勤獎章 2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

5^#

發表於 2010-7-10 20:39 | 只看該作者

Sub OnlyChar()
For i = 1 To Len(ActiveCell.Value)
If Len(ActiveCell) - Len(Replace(ActiveCell, Mid(ActiveCell, i, 1), "")) = 1 Then mystr = mystr & Mid(ActiveCell, i, 1)
Next
MsgBox mystr
End Sub

複製代碼

學海無涯_不恥下問

TOP

GBKEE

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

4^#

發表於 2010-7-10 18:19 | 只看該作者

回復 3# wqfzqgk

原來是 [去除重复的值] 後顯示出沒有重複過的字元
是我第一眼的觀念是錯誤去除重复的值後顯示出全部的的字元

TOP

wqfzqgk

中學生 Rank: 2

帖子: 75
主題: 19
精華: 0
積分: 135
點名: 0
作業系統: win7
軟體版本: 2007 010
閱讀權限: 20
註冊時間: 2010-5-18
最後登錄: 2013-10-26

3^#

發表於 2010-7-10 17:50 | 只看該作者

是去除重复的值，如11223455也只有34符合
是这么个意思
那个地方少了一个&

学习

TOP

GBKEE

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

2^#

發表於 2010-7-10 17:41 | 只看該作者

本帖最後由 GBKEE 於 2010-7-10 17:51 編輯

回復 1# wqfzqgk
請問你所分享的单元格内不重复字符程序中
為何要到二個 scripting.dictionary 物件
Set d = CreateObject("scripting.dictionary")
Set e = CreateObject("scripting.dictionary")
使用一個就足夠如下

Set d = CreateObject("scripting.dictionary")
For i = 1 To Len(ActiveCell.Value)
d(Mid(ActiveCell.Value, i, 1)) = ""
Next
MsgBox Join(d.keys, "")

複製代碼

你使用 If Err.Number = 457 Then d.Remove (Mid(ActiveCell, i, 1))
會導致 MsgBox Join(d.keys, "") 的不正確

請問如下二個迴圈的用意可以說明一下解惑嗎?

For i = 1 To Len(ActiveCell.Value)
For a = 1 To Len(ActiveCell.Value)
If Mid(ActiveCell.Value, i, 1) = Mid(ActiveCell.Value, a, 1) Then m = m + 1
Next
If m = 1 Then mm = mm Mid(ActiveCell.Value, i, 1) 這裡有錯誤
m = 0
Next

複製代碼

TOP